Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / vmsmsg.bli < prev next >

Wrap

Text File | 1990-05-31 | 149.0 KB | 6,714 lines

%TITLE 'KERMSG - Kermit message processing' MODULE KERMSG (IDENT = '3.3.111' %IF %BLISS(BLISS32) %THEN ,ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL) %FI ) = BEGIN SWITCHES LANGUAGE (COMMON); !<BLF/WIDTH:100> !++ ! FACILITY: ! Kermit-10, VMS Kermit, Pro/Kermit ! ! ABSTRACT: ! KERMSG is the message processing routines for Kermit-10, VMS Kermit, ! and PRO/Kermit. ! This module is written in common BLISS, so that it can be ! transported for the DECsystem-10 and VAX/VMS systems. ! ! ENVIRONMENT: ! User mode ! ! AUTHOR: Robert C. McQueen, CREATION DATE: 24-January-1983 ! ! MODIFIED BY: ! !-- %SBTTL 'Table of Contents' !+ !.pag.lit ! Table of Contents for KERMSG ! ! ! Section Page ! 1. Revision History . . . . . . . . . . . . . . . . . . . 3 ! 2. Interface requirements . . . . . . . . . . . . . . . . 4 ! 3. Declarations ! 3.1. Forward definitions . . . . . . . . . . . . . 5 ! 4. Require files. . . . . . . . . . . . . . . . . . . . . 28 ! 5. Macro definitions. . . . . . . . . . . . . . . . . . . 29 ! 6. KERMIT Protocol Definitions. . . . . . . . . . . . . . 30 ! 6.1. Packet offsets. . . . . . . . . . . . . . . . 31 ! 6.2. Message dependent field . . . . . . . . . . . 32 ! 6.3. SEND initiate packet. . . . . . . . . . . . . 33 ! 7. KERMIT Protocol States . . . . . . . . . . . . . . . . 34 ! 8. Internal constants . . . . . . . . . . . . . . . . . . 35 ! 9. Storage - External . . . . . . . . . . . . . . . . . . 36 ! 10. Storage - Local. . . . . . . . . . . . . . . . . . . . 37 ! 11. External references. . . . . . . . . . . . . . . . . . 38 ! 12. MSG_INIT . . . . . . . . . . . . . . . . . . . . . . . 39 ! 13. SND_ERROR. . . . . . . . . . . . . . . . . . . . . . . 40 ! 14. SERVER - Server mode . . . . . . . . . . . . . . . . . 41 ! 15. SEND_SWITCH. . . . . . . . . . . . . . . . . . . . . . 42 ! 16. REC_SWITCH . . . . . . . . . . . . . . . . . . . . . . 43 ! 17. Server ! 17.1. DO_GENERIC - Execute a generic command. . . . 44 ! 18. DO_TRANSACTION - Main loop for FSM . . . . . . . . . . 45 ! 19. REC_SERVER_IDLE - Idle server state. . . . . . . . . . 46 ! 20. SEND_SERVER_INIT . . . . . . . . . . . . . . . . . . . 47 ! 21. SEND_DATA. . . . . . . . . . . . . . . . . . . . . . . 48 ! 22. SEND_FILE. . . . . . . . . . . . . . . . . . . . . . . 49 ! 23. SEND_EOF . . . . . . . . . . . . . . . . . . . . . . . 50 ! 24. SEND_INIT. . . . . . . . . . . . . . . . . . . . . . . 51 ! 25. SEND_OPEN_FILE - Open file for sending . . . . . . . . 52 ! 26. SEND_GENCMD. . . . . . . . . . . . . . . . . . . . . . 53 ! 27. SEND_BREAK . . . . . . . . . . . . . . . . . . . . . . 54 ! 28. REC_INIT . . . . . . . . . . . . . . . . . . . . . . . 55 ! 29. REC_FILE . . . . . . . . . . . . . . . . . . . . . . . 56 ! 30. REC_DATA . . . . . . . . . . . . . . . . . . . . . . . 57 ! 31. SERVER - Generic commands. . . . . . . . . . . . . . . 58 ! 32. HOST_COMMAND - perform a host command. . . . . . . . . 59 ! 33. CALL_SY_RTN - handle operating system dependent functions 60 ! 34. Message processing ! 34.1. PRS_SEND_INIT - Parse send init params. . . . 61 ! 35. SET_SEND_INIT. . . . . . . . . . . . . . . . . . . . . 62 ! 36. SEND_PACKET. . . . . . . . . . . . . . . . . . . . . . 63 ! 37. REC_MESSAGE - Receive a message. . . . . . . . . . . . 64 ! 38. REC_PACKET . . . . . . . . . . . . . . . . . . . . . . 65 ! 39. CALC_BLOCK_CHECK . . . . . . . . . . . . . . . . . . . 66 ! 40. NORMALIZE_FILE - Put file name into normal form. . . . 67 ! 41. Buffer filling ! 41.1. Main routine. . . . . . . . . . . . . . . . . 68 ! 42. BFR_EMPTY. . . . . . . . . . . . . . . . . . . . . . . 69 ! 43. Buffer filling and emptying subroutines. . . . . . . . 70 ! 44. Add parity routine . . . . . . . . . . . . . . . . . . 71 ! 45. Parity routine . . . . . . . . . . . . . . . . . . . . 72 ! 46. Per transfer ! 46.1. Initialization. . . . . . . . . . . . . . . . 73 ! 47. Statistics ! 47.1. Finish message transfer . . . . . . . . . . . 74 ! 48. Status type out ! 48.1. STS_OUTPUT. . . . . . . . . . . . . . . . . . 75 ! 49. TYPE_CHAR - Type out a character . . . . . . . . . . . 76 ! 50. Debugging ! 50.1. DBG_SEND. . . . . . . . . . . . . . . . . . . 77 ! 50.2. DBG_RECEIVE . . . . . . . . . . . . . . . . . 78 ! 50.3. DBG_MESSAGE . . . . . . . . . . . . . . . . . 79 ! 51. End of KERMSG. . . . . . . . . . . . . . . . . . . . . 80 !.end lit.pag !- %SBTTL 'Revision History' !++ ! Start of version 1. ! ! 1.0.000 By: Robert C. McQueen On: 4-Jan-1983 ! Create this program. ! ! 1.0.001 By: Robert C. McQueen On: 30-Apr-1983 ! Change PAR_xxx to be PR_xxx, so that they can be used for ! KERMIT-10. ! ! 1.0.002 By: Robert C. McQueen On: 1-May-1983 ! Add DO_GENERIC routine to cause a generic Kermit command to ! be executed on the remote Kermit. ! ! 1.0.003 By: Robert C. McQueen On: 3-May-1983 ! Fix message number incrementing. ! ! 1.0.004 By: Robert C. McQueen On: 4-May-1983 ! Allow RECEIVE file-specification to work correctly. ! ! 1.0.005 By: Robert C. McQueen On: 6-May-1983 ! Add more stats support. ! ! 1.0.006 By: Nick Bush On: 13-June-1983 ! Fix SEND_PACKET to copy correct characters when fixing ! parity bits. ! ! 1.1.007 By: Nick Bush On: 15-July-1983 ! Correct SEND-INIT message handling to do the right things ! with the protocol version 3 items. ! ! 1.1.010 By: Robert C. McQueen On: 20-July-1983 ! Make PARITY a global routine, so that it can be called by ! CONNECT processing. Change the name from PARITY to GEN_PARITY ! add a new routine to generate the parity, since it is not ! part of the checksum. ! ! 1.1.011 By: Robert C. McQueen On: 28-July-1983 ! KER_TIMEOUT errors in the SERVER loop would cause ! KER_UNISRV error messages to be returned to the remote. ! Check for receive failures and send NAKs instead. ! ! 1.2.012 By: Robert C. McQueen On: 23-August-1983 ! Don't abort if we get a message that is just an end of line ! character. It could be noise on the line. ! ! 1.2.013 By: Nick Bush On: 7-September-1983 ! Fix several problems with the SEND_xxx parameters ! ! 1.2.014 By: Robert C. McQueen On: 15-September-1983 ! Add routine calls to XFR_STATUS to tell the user on the ! number of packets have changed. ! ! 1.2.015 By: Nick Bush On: 5-October-1983 ! Add 2 and 3 character checksum (block check) support. ! Add support for data within acknowledgement packets ! and withing end-of-file packets to allow for file ! transmission to be aborted. Also add support for ! "I" packet to allow server parameters to be initialized. ! ! 1.2.016 By: Nick Bush On: 19-October-1983 ! Add repeat character support. ! ! 2.0.017 Release TOPS-10 Kermit-10 version 2.0 ! Release VAX/VMS Kermit-32 version 2.0 ! ! 2.0.018 By: Robert C. McQueen On: 16-November-1983 ! Fix four checks on the message number that were not ! mod 64. ! ! 2.0.019 By: Robert C. McQueen On: 16-November-1983 ! Remove the CLEAR routine. It is not really needed. ! ! 2.0.020 By: Nick Bush On: 12-Dec-1983 ! Fix SEND_DATA and BFR_FILL to handle empty files and ! files which happen to end just on a message boundary. ! This would sometimes produce extra nulls. ! ! 2.0.021 By: Nick Bush On: 15-Dec-1983 ! Fix some problems with REC_MESSAGE which would cause ! aborts when a message timed out. ! ! 2.0.022 By: Robert C. McQueen 19-Dec-1983 ! Make STATUS a local for most routines and remove FILE_DUMP ! as it is nolonger needed. ! ! 2.0.023 By: Nick Bush On: 3-Jan-1984 ! Change FIL_NORMAL_FORM to contain not just a flag, but ! a file name type instead. ! ! 2.0.024 By: Nick Bush On: 11-Jan-1984 ! Fix REC_MESSAGE to send NAK for packet we expect, not ! previous packet. ! ! 2.0.025 By: Nick Bush On: 23-Jan-1984 ! Re-enable server-init packet and complete code so that ! parameters set by it will remain set. ! Fix file name copying to use BFR_FILL or BFR_EMPTY ! so that all quoting/compression is done properly. ! ! 2.0.026 By: Nick Bush On: 15-Feb-1984 ! Add code for generic command support (both directions). ! There is now only one state dispatch loop, entered ! in various states for different functions. ! ! 2.0.027 By: Robert C. McQueen On: 16-Feb-1984 ! At some point SEND_TIMEOUT became global, but it was not moved ! to KERGLB. This edit moves it to KERGLB.BLI. ! ! 2.0.030 By: Nick Bush On: 2-March-1984 ! Fix BFR_FILL to handle case of last repeated character ! not fitting within a packet. It was forgetting to ! send the characters at all. ! ! 2.0.031 By: Nick Bush On: 6-March-1984 ! Make sure FILE_OPEN_FLAG is set properly when advancing ! to next file of a wild-card send. The file was not ! being set true, leading to problems after a couple files. ! ! 2.0.032 By: Nick Bush On: 9-March-1984 ! Fix UNPACK_DATA in SERVER_GENERIC to properly store ! new string pointer. ! ! 2.0.033 By: Robert C. McQueen On: 12-March-1984 ! If NEXT_FILE fails with anything other than a NOMORFILES ! it should change state to STATE_A not STATE_SB. This ! fixes a problem caused by Pro/Kermit and KERFIL (VMS). ! ! 2.0.034 By: Nick Bush On: 15-March-1984 ! Put file spec into X packet as well as F packet. This ! makes wild card TYPE's work nicer. ! ! 2.0.035 By: Nick Bush On: 20-March-1984 ! Fix send/receive quoting to conform to the way the ! protocol manual says it should be done, rather ! than the way we (and Kermit-20) have always done it. ! ! 2.0.036 By: Nick Bush On: 28-March-1984 ! Make SERVER_GENERIC more defensive against badly ! constructed packets. If an argument has negative ! length, punt the request. Also put angle brackets ! around data from "X" packet header, so file names will ! stick out. ! ! 3.0.037 Start of version 3. ! ! 3.0.040 By: Nick Bush On: 2-April-1984 ! Add separate server timeout. This allows stopping the ! server NAK's without affecting the normal packet timeout. ! ! 3.0.041 By: Nick Bush On: 12-April-1984 ! Fix block check calculation to account for the fact ! that the parity bits are put onto the message when ! it is sent (in place), so that if a retransmission is ! done without refilling the buffer (as is normal with ! data messages), the parity bits will be there. Make ! sure we strip them out for block check calculation. ! ! 3.1.042 By: Nick Bush On: 27-August-1984 ! If we get too many retries when sending a server init (I) ! packet, don't abort. Instead, just try sending the server ! command, since the Kermit on the other end might be coded ! wrong and is responding to packets it doesn't understand ! with a NAK. ! ! 3.1.043 By: Nick Bush On: 27-August-1984 ! Don't abort receives on zero length messages. Just treat ! it like a timeout. ! ! 3.1.044 By: Nick Bush On: 10-April-1985 ! Remove IBM mode. It will be instituted by IBM_CHAR being ! set >= 0 if handshaking is needed. ! ! 3.1.045 BY: David Stevens On: 15-July-1985 ! Fix terminal message for multiple file sendings. Type out ! "Sending: " in the system dependent NEXT_FILE routine. ! ! Start of version 3.2 ! ! 3.2.070 By: Robert McQueen On: 17-Dec-1985 ! Fix CRC calculations when sending 8 bit data and not ! using 8 bit quoting. ! ! 3.2.071 By: Robert McQueen On: 11-March-186 ! Include space in the message buffer for the line termination ! character. ! ! 3.3.100 By: Gregory P. Welsh On: 1-June-1986 ! Made FILE_OPEN_FLAG GLOBAL so it could be updated properly for ! Transmit function from module KERTRM. Also renamed it to ! FFILE_OPEN_FLAG so it could be distinguished externally from ! routine FILE_OPEN. ! ! 3.3.104 By: Robert McQueen On: 5-July-1986 ! Add changes/fixes suggested by Art Guion and David Deley for ! KERMSG.BLI. ! - Always attempt a handshake in IBM mode. Failing to handshake ! may cause 3704/5 style controller to hang a VM system. ! - Don't lose the last character in a buffer. BFR_FILL logic ! forgets to send the last cahracters of a file when it doesn't ! fit into the current packet. ! ! 3.3.107 By: Antonino N. Mione On: 8-Sep-1986 ! Do not abort on ERROR packet while in SERVER mode. Instead, ! return to SERVER IDLE mode. ! ! 3.3.108 By: Burt Johnson On: 1-Feb-1990 ! Added Dan Norstedt's TOP10 support for Extended Length packets; ! Header parity is computed, but not used. ! Undone 3.3.107, to allow for Ctrl-Cs to work properly ! Added PSECT PLIT = $CODE$ to accommodate TT_TEXT address ! references within 32k word_relative address boundry. ! ! 3.3.109 JHW007 Jonathan H. Welch, 4-Apr-1990 17:05 ! Backed out 3.3.108 PSECT PLIT = $CODE$ and replaced it ! with a compile-time test for BLISS32 systems so that ! references to data use longword offsets. ! ! 3.3.110 JHW008 Jonathan H. Welch, 5-Apr-1990 10:57 ! Modified the call to NORMALIZE_FILE in routine REC_FILE ! to adjust file name and type lengths downwards to 39 ! characters each as opposed to the pre-VMS 4 format of ! 9 for the name and 3 for the type. ! ! 3.3.111 JHW011 Jonathan H. Welch, 17-May-1990 9:06 ! Modified a miscoded call to send_packet in routine ! send_gencmd to correctly specify the length of the ! response packet to transmit. This miscoding only ! affected long packet support, in particular, when ! GETting files standard length packets were being used ! when long packet support was available in both kermit ! programs. !-- %SBTTL 'Interface requirements' !++ ! Interface requirements ! ! The following routines and data locations are rquired for a correct ! implementation of KERMIT. ! ! File routines: ! ! FILE_OPEN (Function) ! This routine will open a file for reading or writting. It ! will assume that FILE_SIZE contains the number of bytes ! and FILE_NAME contains the file name of length FILE_SIZE. ! The function that is passed is either FNC_READ or FNC_WRITE. ! ! FILE_CLOSE () ! This routine will close the currently open file. This ! routine will return the status of the operation. ! ! GET_FILE (Character) ! This routine will get a character from the currently open file ! and store it in the location specified by "Character". There ! will be a true/false value returned by the routine to determine ! if there was an error. ! ! PUT_FILE (Character) ! This routine will output a character to the currently open ! file. It will return a true/false value to determine if the ! routine was successful. ! ! NEXT_FILE () ! This routine will advance to the next file. This routine ! will return false if there are no more files to process. ! ! Communications line routines: ! ! RECEIVE (Buffer address, Address of var to store length into) ! This routine will receive a message from the remote Kermit. ! ! SEND (Buffer address, Length in characters) ! This routine will send a message to the remote Kermit. ! ! GEN_CRC (Buffer address, length in characters) ! This routine will calculate the CRC-CCITT for the characters ! in the buffer. ! ! Operating system routines: ! ! SY_DISMISS (Seconds) ! This routine will cause Kermit to sleep for the specified ! number of seconds. It is used to handle the DELAY parameter. ! ! SY_LOGOUT () ! Log the job off of the system. (Kill the process). ! ! SY_TIME () ! This routine will return the starting time milliseconds. ! It can be the start of Kermit, the system, etc, so long ! as it always is incrementing. ! ! Status routines: ! ! XFR_STATUS (Type, Subtype); ! This routine is called to indicate the occurance of ! a significant event that the user interface may wish ! to inform the user about. The arguments indicate the ! type of event. ! Type: "S" - Send, "R" - Receive ! Subtype: "P" - Packet ! "N" - NAK ! "T" - timeout ! For type = "I" (initiate), "T" (terminate): ! Subtype: "S" - a file send ! "R" - a file receive ! "G" - a generic command ! "I" - for "T" only, returning to server idle ! For type = "F" (file operation): ! Subtype: "S" - open for sending ! "R" - open for receiving ! "C" - closing file OK ! "X" - aborting file by user request ! "Z" - aborting group by user request ! "D" - aborting file, but saving due to disposition ! "A" - aborting file due to protocol error ! ! Error processing: ! ! KRM_ERROR (Error parameter) ! This routine will cause an error message to be issued. ! The error parameter is defined by KERERR. This may cause ! SND_ERROR to be called to send an "E" message to the remote. ! ! Terminal I/O routines: ! ! TERM_DUMP (Buffer, Count) ! DBG_DUMP (Buffer, Count) ! This routine will dump the buffer onto the user's terminal. ! The routine is supplied with the count of the characters ! and the address of the buffer. ! These may be the same routine or different. DBG_DUMP ! is only called for debugging output. ! ! ! ENTRY POINTS ! ! KERMSG contains the following entry points for the KERMIT. ! ! SERVER () ! This routine will cause KERMIT go enter server mode. ! ! SEND_SWITCH () ! This routine will send a file. It expects that the user ! has stored the text of the file name into FILE_NAME and ! the length of the text into FILE_SIZE. ! ! REC_SWITCH () ! This routine will receive a file. It expects that the default ! file name is set up in FILE_NAME and the length is in ! FILE_SIZE. ! ! GEN_PARITY (Character) ! This routine will return the character with the proper parity ! on the character. ! ! SND_ERROR (COUNT, ADDRESS) ! This routine will send the text of an error to the remote ! Kermit. ! ! DO_GENERIC (TYPE) ! This routine will cause a generic function to be sent to ! the remote Kermit. This routine will then do all of the ! necessary hand shaking to handle the local end of the generic ! Kermit command. ! ! ! GLOBAL Storage ! ! The following are the global storage locations that are used to interface ! to KERMSG. These locations contains the various send and receive parameters. ! ! Receive parameters: ! ! RCV_PKT_SIZE ! Receive packet size. ! RCV_NPAD ! Padding length ! RCV_PADCHAR ! Padding character ! RCV_TIMEOUT ! Time out ! RCV_EOL ! End of line character ! RCV_QUOTE_CHR ! Quote character ! RCV_8QUOTE_CHR ! 8-bit quoting character ! RCV_SOH ! Start of header character ! ! Send parameters (Negative values denote the default, positive user supplied): ! ! SND_PKT_SIZE ! Send packet size ! SND_NPAD ! Padding length ! SND_PADCHAR ! Padding character ! SND_TIMEOUT ! Time out ! SND_EOL ! End of line character ! SND_QUOTE_CHR ! Quote character ! SND_SOH ! Start of header character (normally 001) ! ! Statistics: ! ! SND_TOTAL_CHARS ! Total characters sent for this Kermit session ! RCV_TOTAL_CHARS ! Total characters received for this Kermit session ! SND_DATA_CHARS ! Total number of data characters sent for this Kermit session ! RCV_DATA_CHARS ! Total number of data characters received for this Kermit session ! SND_COUNT ! Total number of packets that have been sent ! RCV_COUNT ! Total number of packets that have been received. ! SMSG_TOTAL_CHARS ! Total characters sent for this file transfer ! RMSG_TOTAL_CHARS ! Total characters received for this file transfer ! SMSG_DATA_CHARS ! Total data characters sent for this file transfer ! RMSG_DATA_CHARS ! Total data characters received for this file transfer ! SMSG_NAKS ! Total number of NAKs sent for this file transfer ! RMSG_NAKS ! Total number of NAKs received for this file transfer ! XFR_TIME ! Amount of time the last transfer took in milliseconds. ! TOTAL_TIME ! Total amount of time spend transfering data. ! ! Misc constants: ! ! LAST_ERROR ! ASCIZ of the last error message issued. ! FILE_NAME ! Vector containing the ASCII characters of the file name. ! FILE_SIZE ! Number of characters in the FILE_NAME vector. ! DELAY ! Amount of time to delay ! DUPLEX ! DP_HALF or DP_FULL to denote either half duplex or full duplex. ! [Currently only DP_FULL is supported] ! PKT_RETRIES ! Number of retries to attempt to read a message. ! SI_RETRIES ! Number of retries to attempt on send inits ! DEBUG_FLAG ! Debugging mode on/off ! WARN_FLAG ! File warning flag ! IBM_FLAG ! True if talking to an IBM system, else false. ! ECHO_FLAG ! Local echo flag ! CONNECT_FLAG ! Connected flag; True if terminal and SET LINE are the same ! PARITY_TYPE ! Type of parity to use on sends. ! DEV_PARITY_FLAG ! Device will add parity to message. True if device adds ! parity and false if we must do it. ! FLAG_FILE_OPEN ! File is opened. ! !-- %SBTTL 'Declarations -- Forward definitions' !<BLF/NOFORMAT> ! ! Forward definitions ! FORWARD ROUTINE ! Main loop for a complete transaction DO_TRANSACTION, ! Perform a complete transaction ! Send processing routines SEND_SERVER_INIT, ![026] Send a server init packet SEND_DATA, ! Send data to the micro SEND_FILE, ! Send file name SEND_OPEN_FILE, ! Open file for sending SEND_GENCMD, ! Send generic command SEND_EOF, ! Send EOF SEND_INIT, ! Send initialization msg SEND_BREAK, ! Send break end of transmission ! Receive processing routines REC_SERVER_IDLE, ! Wait for message while server is idle REC_INIT, ! Receive initialization REC_FILE, ! Receive file information REC_DATA, ! Receive data ! ! Server processing routines ! SERVER_GENERIC, ! Process generic KERMIT commands HOST_COMMAND, ! Process host command KERMIT_COMMAND, ! Process Kermit command CALL_SY_RTN, ! Handle calling system routine and returning result ! ! Statistic gathering routines ! END_STATS : NOVALUE, ! End of a message processing stats routine ! Low level send/receive routines CALC_BLOCK_CHECK, ! Routine to calculate the block check value SET_SEND_INIT : NOVALUE, ! Set up the MSG_SND_INIT parameters. PRS_SEND_INIT, ! Parse MSG_SND_INIT parameters. DO_PARITY : NOVALUE, ! Routine to generate parity for a message GEN_PARITY, ! Routine to add parity to a character SEND_PACKET, ! Send a packet to the remote REC_MESSAGE, ! Receive a message with retry processing REC_PACKET, ! Receive a packet from the remote ! Utility routines NORMALIZE_FILE : NOVALUE, ! Force file name into normal form BFR_EMPTY, ! Empty the data buffer BFR_FILL, ! Fill the data buffer from a file SET_STRING, ![025] Routine to set alternate get/put routines ! for use with in memory strings TYPE_CHAR, ! Type a character from a packet INIT_XFR : NOVALUE, ! Initialize the per transfer processing STS_OUTPUT : NOVALUE, ! Output current transfer status ! ! Debugging routines ! DBG_MESSAGE : NOVALUE, ! Type out a formatted message DBG_SEND : NOVALUE, ! Send message debugging routine DBG_RECEIVE : NOVALUE; ! Receive message debugging routine %SBTTL 'Require files' ! !<BLF/FORMAT> ! ! REQUIRE FILES: ! %IF %BLISS (BLISS32) %THEN LIBRARY 'SYS$LIBRARY:STARLET'; %FI REQUIRE 'KERCOM'; REQUIRE 'KERERR'; %SBTTL 'Macro definitions' ! ! MACROS: ! MACRO CTL (C) = ((C) XOR %O'100')%, CHAR (C) = ((C) + %O'40')%, UNCHAR (C) = ((C) - %O'40')%; %SBTTL 'KERMIT Protocol Definitions' !++ ! The following describes the various items that are found in the ! KERMIT messages. A complete and through desription of the protocol can be ! found in the KERMIT PROTOCOL MANUAL. ! ! ! All KERMIT messages have the following format: ! ! <Mark><CHAR(Count)><CHAR(Seq)><Message-dependent information><Check><EOL> ! ! <MARK> ! Normally SOH (Control-A, octal 001). ! ! <CHAR(Count)> ! Count of the number of characters following this position. ! Character counts of ONLY 0 to 94 are valid. ! [108] Character count = 0 means extended length type packet. ! ! <CHAR(Seq)> ! Packet sequence number, modulo 100 (octal). ! ! [108] <CHAR(Type)> ! [108] Packet type, usually a mnemonic ASCII character. ! [108] ! [108] For Extended Length packets only: ! [108] <CHAR(Count/95)> ! [108] Count of the number of characters / 95, from (HeaderCheck) ! [108] ! [108] <CHAR(Count MOD 95)> ! [108] Count of the number of characters MOD 95, from (HeaderCheck) ! [108] ! [108] <CHAR(HeaderCheck)> ! [108] Kermit type-1 checksum of the 5 preceding ASCII characters. ! ! <MESSAGE-DEPENDENT INFORMATION> ! This field contains the message dependent information. There can ! be multiple fields in this section. See the KERMIT Protocol document ! for a complete description of this. ! ! <Check> ! A block check on the characters in the packet between, but not ! including, the mark and the checksum itself. It may be one to three ! characters, depending upon the type agreed upon. ! ! 1. Single character arithmetic sum equal to: ! chksum = (s + ((s AND 300)/100)) AND 77 ! Character sent is CHAR(chksum). ! ! 2. Two character arithmetic sum. CHAR of bits 6-11 are the first ! character, CHAR of bits 0-5 are the second character. ! ! 3. Three character CRC-CCITT. First character is CHAR of bits 12-15, ! second is CHAR of bits 6-11, third is CHAR of bits 0-5. ! ! ! <EOL> ! End of line. Any line terminator that may be required by the host. !-- %SBTTL 'KERMIT Protocol Definitions -- Packet offsets' !++ ! The following define the various offsets of the standard KERMIT ! packets. !-- LITERAL PKT_MARK = 0, ! <MARK> PKT_COUNT = 1, ! <CHAR(Count)> PKT_SEQ = 2, ! <CHAR(Seq)> PKT_TYPE = 3, ! <Message type> PKT_MSG = 4, ! <MESSAGE-DEPENDENT INFORMATION> PKT_COUNTX1 = 4, ! [108] ! Ext. pkt: <CHAR(MSB(Count))> PKT_COUNTX2 = 5, ! [108] ! Ext. pkt: <CHAR(LSB(Count))> PKT_HCHECK = 6, ! [108] ! Ext. pkt: Header parity PKT_MSGX = 7, ! [108] ! <MESSAGE-DEPENDENT INFORMATION> PKT_MAX_MSG = 94 - 5, ! Maximum size of the message dependent ! information PKT_CHKSUM = 0, ! <CHAR(Chksum)> offset from end of ! Message dependent information PKT_EOL = 1, ! <Eol> offset from end of data ! [108] PKT_OVR_HEAD_B = 2, ! Header overhead ! [108] PKT_OVR_HEAD_E = 1, ! Overhead at the end PKT_OVR_HEAD = 3, ! Overhead added to data length PKT_TOT_OVR_HEAD = 6; ! Total overhead of the message %SBTTL 'KERMIT Protocol Definitions -- Message dependent field' !++ ! The MESSAGE-DEPENDENT information field of the message contains at ! least one part. That is the type of message. The remainder of the message ! MESSAGE-DEPENDENT field is different depending on the message. ! ! <TYPE><TYPE-DEPENDENT-INFORMATION> ! ! <TYPE> ! The type defines the type of message that is being processed. ! !-- ! Protocol version 1.0 message types LITERAL MSG_DATA = %C'D', ! Data packet MSG_ACK = %C'Y', ! Acknowledgement MSG_NAK = %C'N', ! Negative acknowledgement MSG_SND_INIT = %C'S', ! Send initiate MSG_BREAK = %C'B', ! Break transmission MSG_FILE = %C'F', ! File header MSG_EOF = %C'Z', ! End of file (EOF) MSG_ERROR = %C'E'; ! Error ! Protocol version 2.0 message types LITERAL MSG_RCV_INIT = %C'R', ! Receive initiate MSG_COMMAND = %C'C', ! Host command MSG_GENERIC = %C'G', ! Generic KERMIT command. MSG_KERMIT = %C'K'; ! Perform KERMIT command (text) ! Protocol version 4.0 message types LITERAL MSG_SER_INIT = %C'I', ! Server initialization MSG_TEXT = %C'X'; ! Text header message !++ ! Generic KERMIT commands !-- LITERAL MSG_GEN_LOGIN = %C'I', ! Login MSG_GEN_EXIT = %C'F', ! Finish (exit to OS) MSG_GEN_CONNECT = %C'C', ! Connect to a directory MSG_GEN_LOGOUT = %C'L', ! Logout MSG_GEN_DIRECTORY = %C'D', ! Directory MSG_GEN_DISK_USAGE = %C'U', ! Disk usage MSG_GEN_DELETE = %C'E', ! Delete a file MSG_GEN_TYPE = %C'T', ! Type a file specification ! MSG_GEN_SUBMIT = %C'S', ! Submit ! MSG_GEN_PRINT = %C'P', ! Print MSG_GEN_WHO = %C'W', ! Who's logged in MSG_GEN_SEND = %C'M', ! Send a message to a user MSG_GEN_HELP = %C'H', ! Help MSG_GEN_QUERY = %C'Q', ! Query status MSG_GEN_RENAME = %C'R', ! Rename file MSG_GEN_COPY = %C'K', ! Copy file MSG_GEN_PROGRAM = %C'P', ! Run program and pass data MSG_GEN_JOURNAL = %C'J', ! Perform journal functions MSG_GEN_VARIABLE = %C'V'; ! Return/set variable state ! ! Acknowledgement modifiers (protocol 4.0) ! LITERAL MSG_ACK_ABT_CUR = %C'X', ! Abort current file MSG_ACK_ABT_ALL = %C'Z'; ! Abort entire stream of files ! ! End of file packet modifier ! LITERAL MSG_EOF_DISCARD = %C'D'; ! Discard data from previous file %SBTTL 'KERMIT Protocol Definitions -- SEND initiate packet' !++ ! ! The following describes the send initiate packet. All fields in the message ! data area are optional. ! ! <"S"><CHAR(Bufsiz)><CHAR(Timeout)><CHAR(npad)><CTL(pad)><CHAR(Eol)><Quote> ! <8-bit-quote><Check-type><Repeat-count-processing><Reserved><Reserved> ! ! BUFSIZ ! Sending Kermit's maximum buffer size. ! ! Timeout ! Number of seconds after which the sending Kermit wishes to be timed out ! ! Npad ! Number of padding caracters the sending Kermit needs preceding each ! packet. ! ! PAD ! Padding character. ! ! EOL ! A line terminator required on all packets set by the receiving ! Kermit. ! ! Quote ! The printable ASCII characer the sending Kermit will use when quoting ! the control cahracters. Default is "#". ! ! 8-bit-quote ! Specify quoting mecanism for 8-bit quantities. A quoting mecanism is ! mecessary when sending to hosts which prevent the use of the 8th bit ! for data. When elected, the quoting mechanism will be used by both ! hosts, and the quote character must be in the range of 41-76 or 140-176 ! octal, but different from the control-quoting character. This field is ! interpreted as follows: ! ! "Y" - I agree to 8-bit quoting if you request it. ! "N" - I will not do 8-bit quoting. ! "&" - (or any other character in the range of 41-76 or 140-176) I want ! to do 8-bit quoting using this character (it will be done if the ! other Kermit puts a "Y" in this field. ! Anything else: Quoting will not be done. ! ! Check-type ! Type of block check. The only values presently allowed in this ! field are "1", "2" or "3". Future implementations may allow other ! values. Interpretation of the values is: ! ! "1" - Single character checksum. Default value if none specified. ! "2" - Double character checksum. ! "3" - Three character CRC. ! ! Repeat-count-processing ! The prefix character to be used to indicate a repeated character. ! This can be any printable cahracter other than blank (which denotes ! no repeat count). ! ! [108] Capability byte(s) ! [108] Bit mask containing extra capabilities, currently we only use ! [108] bit 1 (extended-length packets) and bit 0 (more capability ! [108] bytes follows). ! [108] ! [108] Window length (not used) ! [108] ! [108] Extended packet length ! [108] Maximum length for extended-length packets ! !-- LITERAL P_SI_BUFSIZ = 0, ! Buffersize MY_PKT_SIZE = 80, ! My packet size P_SI_TIMOUT = 1, ! Time out MY_TIME_OUT = 15, ! My time out P_SI_NPAD = 2, ! Number of padding characters MY_NPAD = 0, ! Amount of padding I require P_SI_PAD = 3, ! Padding character MY_PAD_CHAR = 0, ! My pad character P_SI_EOL = 4, ! End of line character MY_EOL_CHAR = %O'015', ! My EOL cahracter P_SI_QUOTE = 5, ! Quote character MY_QUOTE_CHAR = %C'#', ! My quoting character P_SI_8QUOTE = 6, ! 8-bit quote MY_8BIT_QUOTE = %C'&', ! Don't do it P_SI_CHKTYPE = 7, ! Checktype used MY_CHKTYPE = CHK_1CHAR, ! Use single character checksum P_SI_REPEAT = 8, ! Repeat character MY_REPEAT = %C'~', ! My repeat character P_SI_LENGTH = 9, ! Length of the std message ! [108] P_SI_CAPAS = 9, ! [108] ! Capability field (if used) EXTLEN_CAPAS = 2, ! [108] ! Extended length packets P_SI_WINDO = 10, ! [108] ! (Send only) Not used, filler P_SI_MAXLX1 = 11, ! [108] ! (Send only) Ext. len / 95 MY_MAXLX1 = 0, ! [108] P_SI_MAXLX2 = 12, ! [108] ! (Send only) Ext. len MOD 95 MY_MAXLX2 = 80, ! [108] ! [108] P_SI_XLENGTH = 13; ! [108] ! (Send only) Len of ext. msg %SBTTL 'KERMIT Protocol States' !++ ! The following are the various states that KERMIT can be in. ! The state transitions are defined in the KERMIT Protocol manual. !-- LITERAL STATE_MIN = 1, ! Min state number STATE_S = 1, ! Send init state STATE_SF = 2, ! Send file header STATE_SD = 3, ! Send file data packet STATE_SZ = 4, ! Send EOF packet STATE_SB = 5, ! Send break STATE_R = 6, ! Receive state (wait for send-init) STATE_RF = 7, ! Receive file header packet STATE_RD = 8, ! Receive file data packet STATE_C = 9, ! Send complete STATE_A = 10, ! Abort STATE_SX = 11, ! Send text header STATE_SG = 12, ! Send generic command STATE_SI = 13, ! Send server init STATE_ID = 14, ! Server idle loop STATE_II = 15, ! Server idle after server init STATE_FI = 16, ! Server should exit STATE_LG = 17, ! Server should logout STATE_OF = 18, ! Send - open first input file STATE_EX = 19, ! Exit back to command parser STATE_ER = 20, ! Retries exceeded error STATE_MAX = 20; ! Max state number %SBTTL 'Internal constants' !++ ! The following represent various internal KERMSG constants. !-- LITERAL MAX_PKT_RETRIES = 16, ! Maximum packet retries MAX_SI_RETRIES = 5; ! Maximum send init retries %SBTTL 'Storage - External' ! ! OWN STORAGE: ! EXTERNAL ! ! Receive parameters ! RCV_PKT_SIZE, ! Receive packet size RCV_NPAD, ! Padding length RCV_PADCHAR, ! Padding character RCV_TIMEOUT, ! Time out RCV_EOL, ! EOL character RCV_QUOTE_CHR, ! Quote character RCV_SOH, ! Start of header character RCV_8QUOTE_CHR, ! 8-bit quoting character ! ! Miscellaneous parameters ! SET_REPT_CHR, ! Repeat character ! ! Send parameters ! SND_PKT_SIZE, ! Send packet size SND_NPAD, ! Padding length SND_PADCHAR, ! Padding character SND_TIMEOUT, ! Time out SND_EOL, ! EOL character SND_QUOTE_CHR, ! Quote character SND_SOH, ! Start of header character SEND_TIMEOUT, ! Time to wait for receiving message ! ! Server parameters ! SRV_TIMEOUT, ! Time between NAK's when server is idle ! ! Statistics ! SND_TOTAL_CHARS, ! Total characters sent RCV_TOTAL_CHARS, ! Total characters received SND_DATA_CHARS, ! Total number of data characters sent RCV_DATA_CHARS, ! Total number of data characters received SND_NAKS, ! Total NAKs sent RCV_NAKS, ! Total NAKs received SND_COUNT, ! Count of total number of packets RCV_COUNT, ! Count of total number packets received SMSG_COUNT, ! Total number of packets sent RMSG_COUNT, ! Total number of packets received SMSG_TOTAL_CHARS, ! Total chars sent this file xfer RMSG_TOTAL_CHARS, ! Total chars rcvd this file xfer SMSG_DATA_CHARS, ! Total data chars this file xfer RMSG_DATA_CHARS, ! Total data chars this file xfer SMSG_NAKS, ! Total number of NAKs this file xfer RMSG_NAKS, ! Total number of NAKs received XFR_TIME, ! Amount of time last xfr took TOTAL_TIME, ! Total time of all xfrs ! this file xfer LAST_ERROR : VECTOR [CH$ALLOCATION (MAX_MSG + 1)], ! Last error message ! ! Misc constants. ! FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], FILE_SIZE, SI_RETRIES, ! Send init retries to attempt PKT_RETRIES, ! Number of retries to try for a message DELAY, ! Amount of time to delay DUPLEX, ! Type of connection (half or full) PARITY_TYPE, ! Type of parity to use DEV_PARITY_FLAG, ! True if output device does ! parity, false if we do it CHKTYPE, ! Type of block check desired ABT_FLAG, ! True if aborted file should be discarded DEBUG_FLAG, ! Debugging mode on/off WARN_FLAG, ! File warning flag IBM_CHAR, ! Turnaround character for IBM mode ECHO_FLAG, ! Local echo flag CONNECT_FLAG, ! Connected flag; True if ! terminal and SET LINE are ! the same ABT_CUR_FILE, ! Abort current file ABT_ALL_FILE, ! Abort all files in stream TYP_STS_FLAG, ! Type status next message TY_FIL, ! Type file specs TY_PKT, ! Type packet info FIL_NORMAL_FORM, ! If true, file names should be normalized GEN_1DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Data for generic command GEN_1SIZE, ! Size of data in GEN_1DATA GEN_2DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Second argument for generic command GEN_2SIZE, ! Size of data in GEN_2DATA GEN_3DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Third arg for generic command GEN_3SIZE; ! Size of data in GEN_3DATA %SBTTL 'Storage - Local' ! ! LOCAL OWN STORAGE: ! OWN ! ! Receive parameters ! RECV_8QUOTE_CHR, ! 8th-bit quoting character REPT_CHR, ! Repeat prefix character RECV_PKT_MSG, ! [108] ! Msg offset (4 std, 7 ext.) ! ! Send parameters ! SEND_PKT_SIZE, ! Send packet size SEND_NPAD, ! Padding length SEND_PADCHAR, ! Padding character SEND_EOL, ! EOL character SEND_QUOTE_CHR, ! Quote character SEND_8QUOTE_CHR, ! 8-bit quoting character SEND_INIT_SIZE, ! [108] ! Size of INIT message ! ! Misc parameters ! INI_CHK_TYPE, ! Type of block checking from init message BLK_CHK_TYPE, ! Type of block check to use FLAG_8QUOTE, ! Flag to determine if doing 8bit quoting FLAG_REPEAT, ! True if doing repeated character compression STATE, ! Current state SIZE, ! Size of the current message ! [108] Negative len for ext msgs OLD_RETRIES, ! Saved number of retries done. NUM_RETRIES, ! Number of retries MSG_NUMBER, ! Current message number REC_SEQ, ! Sequence number of msg in REC_MSG REC_LENGTH, ! Length of the message recv'd REC_TYPE, ! Type of the message received. REC_MSG : VECTOR [CH$ALLOCATION (MAX_MSG + 1, CHR_SIZE)], ! Message received SND_MSG : VECTOR [CH$ALLOCATION (MAX_MSG + 1, CHR_SIZE)], ! Message sent FILE_CHARS, ! Number of characters sent or received TEXT_HEAD_FLAG, ! Text header received, not file header NO_FILE_NEEDED, ! Don't open a file INIT_PKT_SENT, ! Server-init sent and ACKed GEN_TYPE, ! Command message type GEN_SUBTYPE, ! Generic command subtype GET_CHR_ROUTINE, ! Address of routine to get a character for BFR_FILL PUT_CHR_ROUTINE; ! Address of routine to put a character for BFR_EMPTY ! ! KERMSG Global storage ! GLOBAL FLAG_FILE_OPEN; ! File is opened. %SBTTL 'External references' ! ! EXTERNAL REFERENCES: ! ! Packet I/O routines EXTERNAL ROUTINE SEND, ! Send a packet to the remote IBM_WAIT, ! Wait for IBM turnaround RECEIVE; ! Receive a packet from the remote ! ! Terminal I/O routines ! EXTERNAL ROUTINE TERM_DUMP : NOVALUE, ! Normal terminal output DBG_DUMP : NOVALUE, ! Debugging output TT_SET_OUTPUT, ! Set output routine TT_CHAR : NOVALUE, ! Output a single character TT_CRLF : NOVALUE, ! Output a CRLF TT_NUMBER : NOVALUE, ! Output a three digit number to the ! terminal TT_TEXT : NOVALUE, ! Output a string to the user's TT_OUTPUT : NOVALUE; ! Force buffered output to terminal ! Operating system routines and misc routines EXTERNAL ROUTINE CRCCLC, ! Calculate a CRC-CCITT XFR_STATUS : NOVALUE, ! Routine to tell the user the ! status of a transfer KRM_ERROR : NOVALUE, ! Issue an error message SY_LOGOUT : NOVALUE, ! Log the job off SY_GENERIC, ! Perform a generic command SY_TIME, ! Return elapsed time in milliseconds SY_DISMISS : NOVALUE; ! Routine to dismiss for n seconds. ! ! External file processing routines ! EXTERNAL ROUTINE FILE_OPEN, ! Open a file for reading/writing FILE_CLOSE, ! Close an open file NEXT_FILE, ! Determine if there is a next file ! and open it for reading. GET_FILE, ! Get a byte from the file PUT_FILE; ! Put a byte in the file. %SBTTL 'MSG_INIT' GLOBAL ROUTINE MSG_INIT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the message processing for ! KERMIT-32/36. ! ! CALLING SEQUENCE: ! ! MSG_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! Initialize some variables ! ! Receive parameters first ! RCV_PKT_SIZE = MY_PKT_SIZE; RCV_NPAD = MY_NPAD; RCV_PADCHAR = MY_PAD_CHAR; RCV_TIMEOUT = MY_TIME_OUT; RCV_EOL = MY_EOL_CHAR; RCV_QUOTE_CHR = MY_QUOTE_CHAR; RCV_SOH = CHR_SOH; RCV_8QUOTE_CHR = MY_8BIT_QUOTE; SET_REPT_CHR = MY_REPEAT; ! ! Send parameters. ! SND_PKT_SIZE = -MY_PKT_SIZE; SND_NPAD = -MY_NPAD; SND_PADCHAR = -MY_PAD_CHAR; SND_TIMEOUT = -MY_TIME_OUT; SND_EOL = -MY_EOL_CHAR; SND_QUOTE_CHR = -MY_QUOTE_CHAR; SND_SOH = CHR_SOH; ! ! Server parameters ! SRV_TIMEOUT = 5*MY_TIME_OUT; ! ! Other random parameters ! PKT_RETRIES = MAX_PKT_RETRIES; ! Number of retries per message SI_RETRIES = MAX_SI_RETRIES; ! Number of retries on send inits DELAY = INIT_DELAY; DUPLEX = DP_FULL; ! Use full duplex DEBUG_FLAG = FALSE; WARN_FLAG = FALSE; ECHO_FLAG = FALSE; BLK_CHK_TYPE = CHK_1CHAR; ! Start using single char checksum CHKTYPE = MY_CHKTYPE; ! Desired block check type INI_CHK_TYPE = .CHKTYPE; ! Same as default for now DEV_PARITY_FLAG = FALSE; ! We generate parity PARITY_TYPE = PR_NONE; ! No parity ABT_FLAG = TRUE; ! Discard incomplete files FLAG_FILE_OPEN = FALSE; IBM_CHAR = -1; ![044] No handsake by default TY_FIL = TRUE; ! Default to typing files TY_PKT = FALSE; ! But not packet numbers FIL_NORMAL_FORM = FNM_NORMAL; ! Default to normal form names GET_CHR_ROUTINE = GET_FILE; ![025] Initialize the get-a-char routine PUT_CHR_ROUTINE = PUT_FILE; ![025] And the put-a-char END; ! End of MSG_INIT %SBTTL 'SND_ERROR' GLOBAL ROUTINE SND_ERROR (COUNT, ADDRESS) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send an error packet to the remote KERMIT. It ! is called with the count of characters and the address of the text. ! ! CALLING SEQUENCE: ! ! SND_ERROR(COUNT, %ASCII 'Error text'); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! !-- BEGIN ! ! Pack the message into the buffer ! SET_STRING (CH$PTR (.ADDRESS), .COUNT, TRUE); BFR_FILL (TRUE); SET_STRING (0, 0, FALSE); ! ! Save the last error message also ! IF .COUNT GTR MAX_MSG THEN COUNT = MAX_MSG; CH$COPY (.COUNT, CH$PTR (.ADDRESS), 0, MAX_MSG + 1, CH$PTR (LAST_ERROR)); IF NOT SEND_PACKET (MSG_ERROR, .SIZE, .MSG_NUMBER) THEN RETURN KER_ABORTED; END; ! End of SND_ERROR %SBTTL 'SERVER - Server mode' GLOBAL ROUTINE SERVER = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the server function in the v2.0 protocol ! for KERMIT. This routine by it's nature will call various operating ! system routines to do things like logging off the system. ! ! CALLING SEQUENCE: ! ! EXIT_FLAG = SERVER(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ! Status returned by various routines DO BEGIN INIT_XFR (); XFR_STATUS (%C'T', %C'I'); ! Now idle STATUS = DO_TRANSACTION (STATE_ID); END UNTIL .STATUS EQL KER_EXIT OR .STATUS EQL KER_ABORTED; RETURN .STATUS; END; ! End of GLOBAL ROUTINE SERVER %SBTTL 'SEND_SWITCH' GLOBAL ROUTINE SEND_SWITCH = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is the state table switcher for sending files. It ! loops until either it is finished or an error is encountered. The ! routines called by SEND_SWITCH are responsible for changing the state. ! ! CALLING SEQUENCE: ! ! SEND_SWITCH(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! Returns: ! TRUE - File sent correctly. ! FALSE - Aborted sending the file. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ! Status result IF .CONNECT_FLAG THEN SY_DISMISS (.DELAY); ! Sleep if the user wanted us to INIT_XFR (); ! Initialize for this transfer TEXT_HEAD_FLAG = FALSE; ! Set text flag correctly XFR_STATUS (%C'I', %C'S'); ! Start of file send STATUS = DO_TRANSACTION (STATE_S); ! Call routine to do real work XFR_STATUS (%C'T', %C'S'); ! Done with send RETURN .STATUS; ! Return the result END; %SBTTL 'REC_SWITCH' GLOBAL ROUTINE REC_SWITCH = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will cause file(s) to be received by the remote ! KERMIT. This routine contains the main loop for the sending of the ! data. ! ! CALLING SEQUENCE: ! ! REC_SWITCH(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! FILE_DESC - Descriptor describing the file to be received by ! the remote KERMIT. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! True - File received correctly. ! FALSE - File transfer aborted. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL INIT_STATE, ! State to start up DO_TRANSACTION in STATUS; ! Status returned by various routines INIT_STATE = STATE_R; ! Initialize the state MSG_NUMBER = 0; INIT_XFR (); ! Initialize the per transfer info ! ! Determine if they said REC <file-spec> ! Send MSG_RCV_INIT and then receive the file ! IF .FILE_SIZE GTR 0 THEN BEGIN GEN_TYPE = MSG_RCV_INIT; ! Use receive-init message CH$MOVE (.FILE_SIZE, CH$PTR (FILE_NAME), CH$PTR (GEN_1DATA)); GEN_1SIZE = .FILE_SIZE; ! Save the length INIT_STATE = STATE_SI; ! Start out with server init END; ! ! Now receive the file normally ! XFR_STATUS (%C'I', %C'R'); ! Start of a file receive STATUS = DO_TRANSACTION (.INIT_STATE); XFR_STATUS (%C'T', %C'R'); ! End of file receive RETURN .STATUS; ! Return the result END; ! End of REC_SWITCH %SBTTL 'Server -- DO_GENERIC - Execute a generic command' GLOBAL ROUTINE DO_GENERIC (TYPE) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send a generic command to the remote Kermit. ! it will do all the processing required for the generic command ! that was executed. It will return to the caller after the ! command has be executed. ! ! CALLING SEQUENCE: ! ! STATUS = DO_GENERIC (Command-type); ! ! INPUT PARAMETERS: ! ! Command-type -- Command type to be executed. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL INIT_STATE; ! Initial state for FSM ! ! Set up the per transfer items ! INIT_XFR (); NUM_RETRIES = 0; MSG_NUMBER = 0; ! ! These are all generic commands ! GEN_TYPE = MSG_GENERIC; ! ! Assume we will not need server init ! INIT_STATE = STATE_SG; CASE .TYPE FROM GC_MIN TO GC_MAX OF SET [GC_EXIT] : GEN_SUBTYPE = MSG_GEN_EXIT; [GC_LOGOUT] : GEN_SUBTYPE = MSG_GEN_LOGOUT; [GC_DIRECTORY] : BEGIN INIT_STATE = STATE_SI; ! We will need server-init GEN_SUBTYPE = MSG_GEN_DIRECTORY; END; [GC_DISK_USAGE] : BEGIN INIT_STATE = STATE_SI; ! We will need server-init GEN_SUBTYPE = MSG_GEN_DISK_USAGE; END; [GC_DELETE] : GEN_SUBTYPE = MSG_GEN_DELETE; [GC_TYPE] : BEGIN INIT_STATE = STATE_SI; ! We will need server-init GEN_SUBTYPE = MSG_GEN_TYPE; END; [GC_HELP] : BEGIN INIT_STATE = STATE_SI; ! We will need server-init GEN_SUBTYPE = MSG_GEN_HELP; END; [GC_LGN] : GEN_SUBTYPE = MSG_GEN_LOGIN; ! Login just gets ACK [GC_CONNECT] : GEN_SUBTYPE = MSG_GEN_CONNECT; ! CWD just gets ACK [GC_RENAME] : GEN_SUBTYPE = MSG_GEN_RENAME; ! Rename file just needs ACK [GC_COPY] : GEN_SUBTYPE = MSG_GEN_COPY; ! Copy file just needs ACK [GC_WHO] : BEGIN INIT_STATE = STATE_SI; ! May get large response GEN_SUBTYPE = MSG_GEN_WHO; END; [GC_SEND_MSG] : GEN_SUBTYPE = MSG_GEN_SEND; ! Just need an ACK [GC_STATUS] : BEGIN INIT_STATE = STATE_SI; ! May get large response GEN_SUBTYPE = MSG_GEN_QUERY; END; [GC_COMMAND] : BEGIN INIT_STATE = STATE_SI; ! Large response likely GEN_TYPE = MSG_COMMAND; ! This is host command END; [GC_KERMIT] : GEN_TYPE = MSG_KERMIT; ! Perform Kermit command (short response) [GC_PROGRAM] : BEGIN INIT_STATE = STATE_SI; ! Assume large response GEN_SUBTYPE = MSG_GEN_PROGRAM; ! Generic program command END; [GC_JOURNAL] : GEN_SUBTYPE = MSG_GEN_JOURNAL; ! Do journal function (short reply) [GC_VARIABLE] : GEN_SUBTYPE = MSG_GEN_VARIABLE; ! Set or get a variable value [INRANGE, OUTRANGE] : BEGIN KRM_ERROR (KER_UNIMPLGEN); RETURN STATE_A; END; TES; RETURN DO_TRANSACTION (.INIT_STATE); ! Go do the command END; ! End of DO_GENERIC %SBTTL 'DO_TRANSACTION - Main loop for FSM' ROUTINE DO_TRANSACTION (INIT_STATE) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This is the main routine for performing a Kermit transaction. ! It is structured as a finite state machine with each state ! determining the next based upon the packet which is received. ! It is supplied with the initial state by the caller. ! ! CALLING SEQUENCE: ! ! Status = DO_TRANSACTION(.INIT_STATE); ! ! INPUT PARAMETERS: ! ! INIT_STATE - Initial state. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL RETURN_VALUE; NUM_RETRIES = 0; ! Initialize the number of retries STATE = .INIT_STATE; ! Initialize the state WHILE TRUE DO CASE .STATE FROM STATE_MIN TO STATE_MAX OF SET ! ! Send states ! [STATE_ID] : ! ! Server while idle. Set the timeout to twice the normal wait ! and wait for something to show up ! BEGIN LOCAL SAVED_TIMEOUT; SAVED_TIMEOUT = .SEND_TIMEOUT; IF .SEND_TIMEOUT NEQ 0 THEN SEND_TIMEOUT = .SRV_TIMEOUT; STATE = REC_SERVER_IDLE (); SEND_TIMEOUT = .SAVED_TIMEOUT; END; [STATE_II] : ! ! Here while server idle after having received a server-init packet ! STATE = REC_SERVER_IDLE (); [STATE_FI, STATE_LG] : ! ! Here when we are supposed to exit ! RETURN KER_EXIT; [STATE_SD] : STATE = SEND_DATA (); [STATE_SF] : STATE = SEND_FILE (); [STATE_SZ] : STATE = SEND_EOF (); [STATE_S] : STATE = SEND_INIT (); [STATE_OF] : STATE = SEND_OPEN_FILE (); [STATE_SI] : STATE = SEND_SERVER_INIT (); [STATE_SG] : STATE = SEND_GENCMD (); [STATE_SB] : STATE = SEND_BREAK (); ! ! Receiving of the data and the end of file message. ! [STATE_RD] : STATE = REC_DATA (); ! ! Receiving the FILE information of the break to end the transfer of ! one or more files ! [STATE_RF] : STATE = REC_FILE (); ! ! Initialization for the receiving of a file ! [STATE_R] : STATE = REC_INIT (); ! ! Here if we have completed the receiving of the file ! [STATE_C] : BEGIN RETURN_VALUE = TRUE; EXITLOOP; END; ! ! Here if we aborted the transfer or we have gotten into some random ! state (internal KERMSG problem). ! [STATE_A, STATE_EX, STATE_ER, INRANGE, OUTRANGE] : BEGIN RETURN_VALUE = FALSE; IF .STATE EQL STATE_EX THEN RETURN_VALUE = KER_ABORTED; ! ! Determine if the file is still open and if so close it ! IF .FLAG_FILE_OPEN THEN BEGIN FLAG_FILE_OPEN = FALSE; IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN TT_TEXT (UPLIT (%ASCIZ' [Aborted]')); TT_CRLF (); END; FILE_CLOSE (.ABT_FLAG AND (.STATE EQL STATE_A OR .STATE EQL STATE_EX OR .STATE EQL STATE_ER)); XFR_STATUS (%C'F', %C'A'); END; ! ! Give error if aborted due to too many retries ! IF .STATE EQL STATE_ER THEN KRM_ERROR (KER_RETRIES); EXITLOOP; END; TES; ! ! End the stats and return to the caller ! END_STATS (); ! RETURN .RETURN_VALUE; END; ! End of DO_TRANSACTION %SBTTL 'REC_SERVER_IDLE - Idle server state' ROUTINE REC_SERVER_IDLE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called from DO_TRANSACTION when is the server idle ! state. It will receive a message and properly dispatch to the new ! state. ! ! CALLING SEQUENCE: ! ! STATE = REC_SERVER_IDLE (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! Almost everything. ! ! OUPTUT PARAMETERS: ! ! Routine value is new state for FSM ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; STATUS = REC_PACKET (); ! ! Now determine what to do by the type of message we have receive. ! IF .STATUS EQL KER_ABORTED THEN RETURN STATE_EX; IF .STATUS THEN BEGIN SELECTONE .REC_TYPE OF SET ! ! Server initialization message received. ACK the ! message and continue. ! [MSG_SER_INIT] : BEGIN IF (STATUS = PRS_SEND_INIT ()) THEN BEGIN SET_SEND_INIT (); IF (STATUS = SEND_PACKET (MSG_ACK, .SEND_INIT_SIZE, .REC_SEQ)) ! [108] THEN BEGIN SND_PKT_SIZE = -.SEND_PKT_SIZE; SND_TIMEOUT = -.SEND_TIMEOUT; SND_NPAD = -.SEND_NPAD; SND_PADCHAR = -.SEND_PADCHAR; SND_EOL = -.SEND_EOL; SND_QUOTE_CHR = -.SEND_QUOTE_CHR; RCV_8QUOTE_CHR = .SEND_8QUOTE_CHR; CHKTYPE = .INI_CHK_TYPE; SET_REPT_CHR = .REPT_CHR; RETURN STATE_II; ! Now idle after INIT END; END; KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; ! ! Send init message received. We must ACK the message and ! then attempt to receive a file from the remote. ! [MSG_SND_INIT] : BEGIN MSG_NUMBER = (.REC_SEQ + 1) AND %O'77'; IF (STATUS = PRS_SEND_INIT ()) THEN BEGIN SET_SEND_INIT (); ! ! ACK the message then receive everything. ! IF SEND_PACKET (MSG_ACK, .SEND_INIT_SIZE, .REC_SEQ) ! [108] THEN BEGIN BLK_CHK_TYPE = .INI_CHK_TYPE; ! Switch to desired form of block check XFR_STATUS (%C'I', %C'R'); ! Start of file receive RETURN STATE_RF; END; END; KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; ! ! Here if we receive a receive init message. ! We will be sending a file to the other end. ! [MSG_RCV_INIT] : BEGIN ! ! Move the file specification if we received one ! SET_STRING (CH$PTR (FILE_NAME), MAX_FILE_NAME, TRUE); BFR_EMPTY (); FILE_SIZE = SET_STRING (0, 0, FALSE); CH$WCHAR (CHR_NUL, CH$PTR (FILE_NAME, .FILE_SIZE)); IF .FILE_SIZE GTR 0 THEN BEGIN XFR_STATUS (%C'I', %C'S'); ! Start of a file send RETURN STATE_S; END; KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; ! ! Generic KERMIT commands ! [MSG_GENERIC] : RETURN SERVER_GENERIC (); ! ! Host command ! [MSG_COMMAND] : RETURN HOST_COMMAND (); ! ! Kermit command ! [MSG_KERMIT] : RETURN KERMIT_COMMAND (); ! ! Unimplimented server routines ! [OTHERWISE] : BEGIN KRM_ERROR (KER_UNISRV); RETURN STATE_A; END; TES; END; ! ! If we get here, we must have gotten something random. Therefore, ! just send a NAK and remain in the current state (unless we have done this ! too many times). ! NUM_RETRIES = .NUM_RETRIES + 1; IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_A; IF SEND_PACKET (MSG_NAK, 0, 0) THEN RETURN .STATE ELSE RETURN STATE_EX; END; ! End of REC_SERVER_IDLE %SBTTL 'SEND_SERVER_INIT' ROUTINE SEND_SERVER_INIT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send a server initialization message to the ! remote KERMIT. ! ! CALLING SEQUENCE: ! ! STATE = SEND_SERVER_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! RECV_xxx - desired receive parameters ! ! OUTPUT PARAMETERS: ! ! New state to change the finite state machine to. ! ! IMPLICIT OUTPUTS: ! ! SEND_xxx - Other Kermit's desired parameters ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL OLD_OUTPUT, ! Saved terminal output routine STATUS; ! Status returned by various routines ![026] Local routine to ignore error message output ROUTINE IGNORE_ERROR (ADDRESS, LENGTH) = BEGIN RETURN TRUE; END; SET_SEND_INIT (); ![026] If too many tries, just give up. Maybe the other Kermit doesn't ![026] know what to do with this packet. IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_SG; ![026] ![026] Count the number of times we try this ![026] NUM_RETRIES = .NUM_RETRIES + 1; IF NOT SEND_PACKET (MSG_SER_INIT, .SEND_INIT_SIZE, .MSG_NUMBER) THEN RETURN STATE_A; ! [108] ![026] ![026] Determine if we received a packet it good condition. If we timed out ![026] just try again. If we get an error packet back, ignore it and ![026] just continue. The other Kermit must not support this packet. ![026] OLD_OUTPUT = TT_SET_OUTPUT (IGNORE_ERROR); STATUS = REC_PACKET (); TT_OUTPUT (); TT_SET_OUTPUT (.OLD_OUTPUT); IF .STATUS EQL KER_ERRMSG THEN RETURN STATE_SG; IF NOT .STATUS THEN IF NOT ((.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR)) THEN RETURN STATE_EX ELSE RETURN .STATE; ! ! Determine if the packet is good. ! IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ EQL .MSG_NUMBER THEN BEGIN ! ! Here if we have an ACK for the initialization message that was just sent ! to the remote KERMIT. ! IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A; NUM_RETRIES = 0; INIT_PKT_SENT = TRUE; ! We have exchanged init's RETURN STATE_SG; END; ! ! If we haven't returned yet, we must have gotten an invalid response. ! Just stay in the same state so we try again ! RETURN .STATE; END; %SBTTL 'SEND_DATA' ROUTINE SEND_DATA = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send a data message to the remote KERMIT. ! ! CALLING SEQUENCE: ! ! STATE = SEND_DATA(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state to change the finite state machine to. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL SUB_TYPE, ! Subtype for XFR_STATUS call STATUS; ! Status returned by various routines ! ! If there is nothing in the data packet, we should not bother to send it. ! Instead, we will just call BFR_FILL again to get some more data ! IF .SIZE NEQ 0 ! [108] THEN BEGIN ! ! Check to see if the number of retries have been exceeded. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER; ! ! Not exceeded yet. Increment the number of retries we have attempted ! on this message. ! NUM_RETRIES = .NUM_RETRIES + 1; ! ! Attempt to send the packet and abort if the send fails. ! IF NOT SEND_PACKET (MSG_DATA, .SIZE, .MSG_NUMBER) THEN RETURN STATE_EX; ! ! Attempt to receive a message from the remote KERMIT. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_EX; END; ! ! Determine if the message is a NAK and the NAK is for the message number ! that we are current working on. If the NAK is for the next packet then ! treat it like an ACK for this packet ! IF .REC_TYPE EQL MSG_NAK AND (.REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77')) THEN RETURN .STATE; ! ! Make sure we have a NAK or ACK ! IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK) THEN ! ! Not an ACK or NAK, abort. ! BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; ! ! Is this for this message? ! IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! It was. Set up for sending the next data message to the remote KERMIT ! and return. ! ! ! Check for data field in ACK indicating abort file or stream ! ! IF .REC_TYPE EQL MSG_ACK AND .REC_LENGTH EQL 1 THEN SELECTONE CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG, CHR_SIZE)) OF ! [108] SET [MSG_ACK_ABT_CUR] : ABT_CUR_FILE = TRUE; [MSG_ACK_ABT_ALL] : ABT_ALL_FILE = TRUE; TES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; END; ! End of IF .SIZE NEQ 0 IF (BFR_FILL (FALSE) EQL KER_NORMAL) AND NOT (.ABT_CUR_FILE OR .ABT_ALL_FILE) THEN RETURN STATE_SD ELSE BEGIN IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN IF .ABT_ALL_FILE THEN TT_TEXT (UPLIT (%ASCIZ' [Group interrupted]')) ELSE IF .ABT_CUR_FILE THEN TT_TEXT (UPLIT (%ASCIZ' [Interrupted]')) ELSE TT_TEXT (UPLIT (%ASCIZ' [OK]')); TT_CRLF (); END; IF .FLAG_FILE_OPEN THEN FILE_CLOSE (FALSE); SUB_TYPE = %C'C'; ! Assume ok IF .ABT_ALL_FILE THEN SUB_TYPE = %C'Z' ELSE IF .ABT_CUR_FILE THEN SUB_TYPE = %C'X'; XFR_STATUS (%C'F', .SUB_TYPE); FLAG_FILE_OPEN = FALSE; RETURN STATE_SZ; END; END; %SBTTL 'SEND_FILE' ROUTINE SEND_FILE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send the file specification that is being ! transfered, or it will send a text header message. ! ! CALLING SEQUENCE: ! ! STATE = SEND_FILE(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TEXT_HEAD_FLAG - If true, send text header instead of file header ! ! OUTPUT PARAMETERS: ! ! New state to change the finite state machine to. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL M_TYPE, ! Message type to send STATUS; ! Status returned by various routines ! ! Flag we don't want to abort yet ! ABT_CUR_FILE = FALSE; ABT_ALL_FILE = FALSE; ! ! First determine if we have exceed the number of retries that are ! allowed to attempt to send this message. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER; ! ! The number of retries are not exceeded. Increment the number and then ! attempt to send the packet again. ! NUM_RETRIES = .NUM_RETRIES + 1; SIZE = 0; ! Assume no name IF .TEXT_HEAD_FLAG THEN M_TYPE = MSG_TEXT ELSE M_TYPE = MSG_FILE; IF .FILE_SIZE NEQ 0 AND NOT .NO_FILE_NEEDED THEN BEGIN ![025] CH$MOVE (.FILE_SIZE, CH$PTR (FILE_NAME), ![025] CH$PTR (SND_MSG, PKT_MSG, ![025] CHR_SIZE)); ![025] ![025] Fill packet with file name ![025] SET_STRING (CH$PTR (FILE_NAME), .FILE_SIZE, TRUE); BFR_FILL (TRUE); SET_STRING (0, 0, FALSE); END; IF NOT SEND_PACKET (.M_TYPE, .SIZE, .MSG_NUMBER) THEN RETURN STATE_EX; ! ! Now get the responce from the remote KERMIT. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_EX; END; ! ! Determine if the packet is good. ! IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK) THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; ! ! If this is a NAK and the message number is not the one we just send ! treat this like an ACK, otherwise resend the last packet. ! IF .REC_TYPE EQL MSG_NAK AND (.REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77')) THEN RETURN .STATE; IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! If all is ok, bump the message number and fill first buffer ! NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; IF BFR_FILL (TRUE) THEN RETURN STATE_SD ELSE RETURN STATE_A; END; ! End of SEND_FILE %SBTTL 'SEND_EOF' ROUTINE SEND_EOF = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send the end of file message to the remote ! KERMIT. It will then determine if there are more files to ! send to the remote. ! ! CALLING SEQUENCE: ! ! STATE = SEND_EOF(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state to change the finite state machine to. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! Sets up for the next file to be processed if there is one. ! !-- BEGIN LOCAL STATUS, ! Status returned by various routines EOF_MSG_LEN; ! Length of EOF message to send ! ! First determine if we have exceed the number of retries that are ! allowed to attempt to send this message. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER; ! ! The number of retries are not exceeded. Increment the number and then ! attempt to send the packet again. ! NUM_RETRIES = .NUM_RETRIES + 1; ! ! Store character in packet to indicate discard of file ! Character will only be sent if file should be discarded ! CH$WCHAR (MSG_EOF_DISCARD, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); IF .ABT_CUR_FILE OR .ABT_ALL_FILE THEN EOF_MSG_LEN = 1 ELSE EOF_MSG_LEN = 0; IF NOT SEND_PACKET (MSG_EOF, .EOF_MSG_LEN, .MSG_NUMBER) THEN RETURN STATE_EX; ! ! Now get the responce from the remote KERMIT. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_EX; END; ! ! Determine if the packet is good. ! IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK) THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; ! ! If this is a NAK and the message number is not the one we just send ! treat this like an ACK, otherwise resend the last packet. ! IF .REC_TYPE EQL MSG_NAK AND (.REC_SEQ NEQ ((.MSG_NUMBER + 1) AND %O'77')) THEN RETURN .STATE; IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! Here to determine if there is another file to send. ! NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; IF NOT .ABT_ALL_FILE THEN STATUS = NEXT_FILE () ELSE STATUS = KER_NOMORFILES; IF ( NOT .STATUS) OR (.STATUS EQL KER_NOMORFILES) THEN BEGIN IF (.STATUS NEQ KER_NOMORFILES) THEN RETURN STATE_A ELSE RETURN STATE_SB; END ELSE BEGIN FLAG_FILE_OPEN = TRUE; ! Have a file open again IF .FIL_NORMAL_FORM THEN NORMALIZE_FILE (FILE_NAME, FILE_SIZE, -1, -1); XFR_STATUS (%C'F', %C'S'); ! Inform display routine IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN !![045] TT_TEXT (UPLIT (%ASCIZ'Sending: ')); TT_TEXT (FILE_NAME); TT_OUTPUT (); END; FILE_CHARS = 0; ! No characters sent yet RETURN STATE_SF; END; END; ! End of SEND_EOF %SBTTL 'SEND_INIT' ROUTINE SEND_INIT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send the initialization packet to the remote ! KERMIT. The message type sent is S. ! ! CALLING SEQUENCE: ! ! STATE = SEND_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state to change the finite state machine to. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ! Status returned by various routines SET_SEND_INIT (); IF .NUM_RETRIES GTR .SI_RETRIES THEN RETURN STATE_ER; ! ! Count the number of times we try this ! NUM_RETRIES = .NUM_RETRIES + 1; IF NOT SEND_PACKET (MSG_SND_INIT, .SEND_INIT_SIZE, .MSG_NUMBER) THEN RETURN STATE_EX; ! [108] ! ! Determine if we received a packet it good condition. If we timed out or ! got an illegal message, just try again. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_EX; END; ! ! Determine if the packet is good. ! IF .REC_TYPE NEQ MSG_ACK THEN RETURN .STATE; IF .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! Here if we have an ACK for the initialization message that was just sent ! to the remote KERMIT. ! IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A; BLK_CHK_TYPE = .INI_CHK_TYPE; ! We now use agreed upon block check type NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_OF; ! Now need to open the file END; %SBTTL 'SEND_OPEN_FILE - Open file for sending' ROUTINE SEND_OPEN_FILE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called from DO_TRANSACTION when the first input file ! needs to be opened. ! ! CALLING SEQUENCE: ! ! STATE = SEND_OPEN_FILE (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! FILE_NAME, FILE_SIZE, etc. ! ! OUPTUT PARAMETERS: ! ! New state for FSM. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN TT_TEXT (UPLIT (%ASCIZ'Sending: ')); TT_OUTPUT (); END; FILE_CHARS = 0; ! No characters sent yet IF NOT .NO_FILE_NEEDED THEN IF NOT FILE_OPEN (FNC_READ) THEN RETURN STATE_A ELSE FLAG_FILE_OPEN = TRUE; ![023] ![023] If we want normalized file names, beat up the name now ![023] IF .FIL_NORMAL_FORM THEN NORMALIZE_FILE (FILE_NAME, FILE_SIZE, -1, -1); XFR_STATUS (%C'F', %C'S'); ! Inform display routine IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN TT_TEXT (FILE_NAME); TT_OUTPUT (); END; RETURN STATE_SF; END; ! End of FSM_OPEN_FILE %SBTTL 'SEND_GENCMD' ROUTINE SEND_GENCMD = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send a command packet to the server Kermit. ! The new state will depend upon the response. If a send-init ! is received, it will process it and switch to STATE_RF. ! If a text-header is received it will switch to STATE_RD. ! If an ACK is received, it will type the data portion and ! switch to STATE_C. ! ! CALLING SEQUENCE: ! ! STATE = SEND_GENCMD(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! GEN_TYPE - Message type to send (normally MSG_GENERIC) ! GEN_SUBTYPE - Message subtype (only if MSG_GENERIC) ! GEN_1DATA - First argument string ! GEN_1SIZE - Size of first argument ! GEN_2DATA - Second argument string ! GEN_2SIZE - Size of second argument ! GEN_3DATA - Third argument string ! GEN_3SIZE - Size of third argument ! ! OUTPUT PARAMETERS: ! ! New state for the finite state machine. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL POINTER, ! Pointer at DATA_TEXT DATA_TEXT : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Data buffer DATA_SIZE, ! Length of data buffer used STATUS; ! Status returned by various routines ROUTINE PACK_DATA (POINTER, LENGTH, SRC_ADDR, SRC_LEN) = ! ! Routine to pack an argument into the buffer. ! BEGIN IF .SRC_LEN GTR MAX_MSG - .LENGTH - 1 THEN SRC_LEN = MAX_MSG - .LENGTH - 1; LENGTH = .LENGTH + .SRC_LEN + 1; CH$WCHAR_A (CHAR (.SRC_LEN), .POINTER); .POINTER = CH$MOVE (.SRC_LEN, CH$PTR (.SRC_ADDR), ..POINTER); RETURN .LENGTH; END; ! ! First determine if we have exceed the number of retries that are ! allowed to attempt to send this message. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER; ! ! The number of retries are not exceeded. Increment the number and then ! attempt to send the packet again. ! NUM_RETRIES = .NUM_RETRIES + 1; ! ! Build the packet data field ! POINTER = CH$PTR (DATA_TEXT); DATA_SIZE = 0; IF .GEN_TYPE EQL MSG_GENERIC THEN BEGIN CH$WCHAR_A (.GEN_SUBTYPE, POINTER); DATA_SIZE = 1; IF .GEN_1SIZE GTR 0 OR .GEN_2SIZE GTR 0 OR .GEN_3SIZE GTR 0 THEN BEGIN DATA_SIZE = PACK_DATA (POINTER, .DATA_SIZE, GEN_1DATA, .GEN_1SIZE); IF .GEN_2SIZE GTR 0 OR .GEN_3SIZE GTR 0 THEN BEGIN DATA_SIZE = PACK_DATA (POINTER, .DATA_SIZE, GEN_2DATA, .GEN_2SIZE); IF .GEN_3SIZE GTR 0 THEN BEGIN DATA_SIZE = PACK_DATA (POINTER, .DATA_SIZE, GEN_3DATA, .GEN_3SIZE); END; END; END; END ELSE BEGIN IF .GEN_1SIZE GTR MAX_MSG THEN GEN_1SIZE = MAX_MSG; DATA_SIZE = .GEN_1SIZE; CH$MOVE (.GEN_1SIZE, CH$PTR (GEN_1DATA), .POINTER); END; SET_STRING (CH$PTR (DATA_TEXT), .DATA_SIZE, TRUE); BFR_FILL (TRUE); SET_STRING (0, 0, FALSE); ! ! Send the packet ! IF NOT SEND_PACKET (.GEN_TYPE, .SIZE, .MSG_NUMBER) THEN RETURN STATE_EX; ! ! Now get the responce from the remote KERMIT. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_EX; END; ! Did we get a send-init? SELECTONE .REC_TYPE OF SET [MSG_SND_INIT] : BEGIN MSG_NUMBER = .REC_SEQ; ! Initialize sequence numbers ! Determine if the parameters are ok. If not, give up IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN .STATUS; SET_SEND_INIT (); ! Set up our acknowledgement to the send-init SEND_PACKET (MSG_ACK, .send_init_size, .MSG_NUMBER); ! Send it BLK_CHK_TYPE = .INI_CHK_TYPE; ! Can now use agreed upon type OLD_RETRIES = .NUM_RETRIES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RF; ! Now expect file header END; [MSG_TEXT] : ! ! If we just got a text header, set up for typing on the terminal and ! shift to receiving data ! BEGIN TEXT_HEAD_FLAG = TRUE; ! We want terminal output PUT_CHR_ROUTINE = TYPE_CHAR; ! Set up the put a character routine IF .REC_LENGTH GTR 0 THEN BEGIN TT_TEXT (UPLIT (%ASCIZ'<<')); ! Make sure file name sticks out BFR_EMPTY (); ! Dump the packet data to the terminal TT_TEXT (UPLIT (%ASCIZ'>>')); ! So user can tell where name ends TT_CRLF (); ! And a CRLF END; SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER); ! Send an ACK OLD_RETRIES = .NUM_RETRIES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RD; ! We now want data END; [MSG_ACK] : ! ! If we get an ACK, just type the data on the terminal and complete the ! transaction. ! BEGIN PUT_CHR_ROUTINE = TYPE_CHAR; ! Dump to terminal BFR_EMPTY (); ! Do it IF .REC_LENGTH GTR 0 THEN TT_CRLF (); RETURN STATE_C; ! And go idle END; [MSG_NAK] : ! ! If we get a NAK, stay in the same state. We will re-transmit the ! packet again. ! RETURN .STATE; TES; ! ! If we get here, we didn't get anything resembling an acceptable ! packet, so we will abort. ! KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; %SBTTL 'SEND_BREAK' ROUTINE SEND_BREAK = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will send the break (end of transmission) message ! to the remote KERMIT. On an ACK the state becomes STATE_C. ! ! CALLING SEQUENCE: ! ! STATE = SEND_BREAK(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state for the finite state machine. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ! Status returned by various routines ! ! First determine if we have exceed the number of retries that are ! allowed to attempt to send this message. ! IF .NUM_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER; ! ! The number of retries are not exceeded. Increment the number and then ! attempt to send the packet again. ! NUM_RETRIES = .NUM_RETRIES + 1; IF NOT SEND_PACKET (MSG_BREAK, 0, .MSG_NUMBER) THEN RETURN STATE_EX; ! ! Now get the responce from the remote KERMIT. ! STATUS = REC_PACKET (); IF NOT .STATUS THEN BEGIN IF (.STATUS EQL KER_ZEROLENMSG) OR (.STATUS EQL KER_TIMEOUT) OR (.STATUS EQL KER_CHKSUMERR) THEN RETURN .STATE ELSE RETURN STATE_EX; END; ! ! Determine if the packet is good. ! IF NOT (.REC_TYPE EQL MSG_ACK OR .REC_TYPE EQL MSG_NAK) THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; ! ! If this is a NAK and the message number is not the one we just send ! treat this like an ACK, otherwise resend the last packet. ! IF .REC_TYPE EQL MSG_NAK AND .REC_SEQ NEQ 0 THEN RETURN .STATE; IF .REC_TYPE EQL MSG_ACK AND .REC_SEQ NEQ .MSG_NUMBER THEN RETURN .STATE; ! ! Here to determine if there is another file to send. ! NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_C; END; %SBTTL 'REC_INIT' ROUTINE REC_INIT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will process an initialization message received from ! the remote KERMIT. ! ! CALLING SEQUENCE: ! ! STATE = REC_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New machine state. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ! Status returned by various routines ROUTINE CHECK_INIT = BEGIN IF .REC_TYPE EQL MSG_SND_INIT THEN RETURN TRUE ELSE RETURN FALSE; END; IF NOT (STATUS = REC_MESSAGE (CHECK_INIT)) THEN IF .STATUS NEQ KER_ABORTED THEN RETURN STATE_A ELSE RETURN STATE_EX; MSG_NUMBER = .REC_SEQ; IF NOT (STATUS = PRS_SEND_INIT ()) THEN RETURN STATE_A; SET_SEND_INIT (); SEND_PACKET (MSG_ACK, .SEND_INIT_SIZE, .MSG_NUMBER); ! [108] BLK_CHK_TYPE = .INI_CHK_TYPE; ! Can now use agreed upon type OLD_RETRIES = .NUM_RETRIES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RF; END; ! End of REC_INIT %SBTTL 'REC_FILE' ROUTINE REC_FILE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine expects to receive an MSG_FILE packet from the remote ! KERMIT. If the message is correct this routine will change the state ! to STATE_RD. ! ! This routine also expects MSG_SND_INIT, MSG_EOF, or MSG_BREAK. ! ! CALLING SEQUENCE: ! ! STATE = REC_FILE(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ROUTINE CHECK_FILE = BEGIN IF (.REC_TYPE EQL MSG_SND_INIT) OR (.REC_TYPE EQL MSG_EOF) OR (.REC_TYPE EQL MSG_FILE) OR ( .REC_TYPE EQL MSG_BREAK) OR (.REC_TYPE EQL MSG_TEXT) THEN RETURN TRUE ELSE RETURN FALSE; END; ! ! Initialize the abort flags ! ABT_CUR_FILE = FALSE; ABT_ALL_FILE = FALSE; ! ! Get a message ! IF NOT (STATUS = REC_MESSAGE (CHECK_FILE)) THEN IF .STATUS NEQ KER_ABORTED THEN RETURN STATE_A ELSE RETURN STATE_EX; SELECTONE .REC_TYPE OF SET [MSG_SND_INIT] : BEGIN IF .OLD_RETRIES GTR .SI_RETRIES THEN RETURN STATE_ER; OLD_RETRIES = .OLD_RETRIES + 1; IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ THEN BEGIN SET_SEND_INIT (); BLK_CHK_TYPE = CHK_1CHAR; ! Must use 1 character CHKSUM SEND_PACKET (MSG_ACK, .SEND_INIT_SIZE, .REC_SEQ); ! [108] BLK_CHK_TYPE = .INI_CHK_TYPE; ! Back to agreed upon type NUM_RETRIES = 0; RETURN .STATE; END ELSE BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; END; [MSG_EOF] : BEGIN IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER; OLD_RETRIES = .OLD_RETRIES + 1; IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ THEN BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); NUM_RETRIES = 0; RETURN .STATE; END ELSE BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; END; [MSG_FILE] : BEGIN IF .MSG_NUMBER NEQ .REC_SEQ THEN RETURN STATE_ER; IF .REC_LENGTH EQL 0 THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; ![025] ![025] Get file name from packet with all quoting undone ![025] SET_STRING (CH$PTR (FILE_NAME), MAX_FILE_NAME, TRUE); BFR_EMPTY (); FILE_SIZE = SET_STRING (0, 0, FALSE); CH$WCHAR (CHR_NUL, CH$PTR (FILE_NAME, .FILE_SIZE)); ![025] FILE_SIZE = .REC_LENGTH; ![025] CH$COPY (.REC_LENGTH, CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE), CHR_NUL, MAX_FILE_NAME, ![025] CH$PTR (FILE_NAME)); IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN TT_TEXT (UPLIT (%ASCIZ'Receiving: ')); TT_TEXT (FILE_NAME); TT_OUTPUT (); END; ![023] ![023] Force file name into normal form if desired ![023] IF .FIL_NORMAL_FORM THEN NORMALIZE_FILE (FILE_NAME, FILE_SIZE, 39, 39); FILE_CHARS = 0; ! No characters received yet IF NOT FILE_OPEN (FNC_WRITE) THEN RETURN STATE_A; XFR_STATUS (%C'F', %C'R'); ! Tell display routine TEXT_HEAD_FLAG = FALSE; ! Got an F, not an X FLAG_FILE_OPEN = TRUE; SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER); OLD_RETRIES = .NUM_RETRIES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RD; END; [MSG_TEXT] : ! ! If we get a text header, we will want to type the data on ! the terminal. Set up the put a character routine correctly. ! BEGIN IF .MSG_NUMBER NEQ .REC_SEQ THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; TEXT_HEAD_FLAG = TRUE; ! Got an X, not an F PUT_CHR_ROUTINE = TYPE_CHAR; ! Empty buffer on terminal IF .REC_LENGTH GTR 0 THEN BEGIN TT_TEXT (UPLIT (%ASCIZ'<<')); ! Make file name stick out BFR_EMPTY (); ! Do the header data TT_TEXT (UPLIT (%ASCIZ'>>')); TT_CRLF (); ! And a crlf END; SEND_PACKET (MSG_ACK, 0, .MSG_NUMBER); OLD_RETRIES = .NUM_RETRIES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RD; END; [MSG_BREAK] : BEGIN IF .MSG_NUMBER NEQ .REC_SEQ THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; SEND_PACKET (MSG_ACK, 0, .REC_SEQ); RETURN STATE_C; END; [OTHERWISE] : BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; TES; END; ! End of REC_FILE %SBTTL 'REC_DATA' ROUTINE REC_DATA = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will accept data messages and write them to disk. ! It will also accept MSG_FILE, MSG_TEXT and MSG_EOF messages. ! ! CALLING SEQUENCE: ! ! STATE = REC_DATA(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! New state for the finite state machine. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ROUTINE CHECK_DATA = BEGIN IF .REC_TYPE EQL MSG_DATA OR (.REC_TYPE EQL MSG_FILE AND NOT .TEXT_HEAD_FLAG) OR .REC_TYPE EQL MSG_EOF OR (.REC_TYPE EQL MSG_TEXT AND .TEXT_HEAD_FLAG) THEN RETURN TRUE ELSE RETURN FALSE; END; LOCAL SUB_TYPE, ! Subtype for XFR_STATUS DISCARD_FILE_FLAG, ! Sender requested discard ACK_MSG_LEN; ! Length of ACK to send ! ! First get a message ! IF NOT (STATUS = REC_MESSAGE (CHECK_DATA)) THEN IF .STATUS NEQ KER_ABORTED THEN RETURN STATE_A ELSE RETURN STATE_EX; SELECTONE .REC_TYPE OF SET [MSG_DATA] : BEGIN IF .MSG_NUMBER NEQ .REC_SEQ THEN BEGIN IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER; OLD_RETRIES = .OLD_RETRIES + 1; IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ THEN BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); NUM_RETRIES = 0; RETURN .STATE; END ELSE BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; END; ! ! Here if we have a message with a valid message number ! IF NOT BFR_EMPTY () THEN RETURN STATE_A; ! ! Check if we wish to abort for some reason ! IF .ABT_CUR_FILE THEN BEGIN CH$WCHAR (MSG_ACK_ABT_CUR, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); ACK_MSG_LEN = 1; END ELSE IF .ABT_ALL_FILE THEN BEGIN CH$WCHAR (MSG_ACK_ABT_ALL, CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE)); ACK_MSG_LEN = 1; END ELSE ACK_MSG_LEN = 0; ! ! Now send the ACK ! SEND_PACKET (MSG_ACK, .ACK_MSG_LEN, .REC_SEQ); OLD_RETRIES = .NUM_RETRIES; NUM_RETRIES = 0; MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RD; END; [MSG_FILE, MSG_TEXT] : BEGIN IF .OLD_RETRIES GTR .PKT_RETRIES THEN RETURN STATE_ER; OLD_RETRIES = .OLD_RETRIES + 1; IF ((.MSG_NUMBER - 1) AND %O'77') EQL .REC_SEQ THEN BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); NUM_RETRIES = 0; RETURN .STATE; END ELSE BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; END; [MSG_EOF] : BEGIN IF .MSG_NUMBER NEQ .REC_SEQ THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; SEND_PACKET (MSG_ACK, 0, .REC_SEQ); IF NOT .TEXT_HEAD_FLAG THEN BEGIN FLAG_FILE_OPEN = FALSE; DISCARD_FILE_FLAG = FALSE; ! Assume we want file IF .REC_LENGTH EQL 1 THEN IF CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG, CHR_SIZE)) EQL MSG_EOF_DISCARD ! [108] THEN DISCARD_FILE_FLAG = TRUE; IF ( NOT .CONNECT_FLAG) AND .TY_FIL THEN BEGIN IF .DISCARD_FILE_FLAG THEN IF .ABT_FLAG THEN TT_TEXT (UPLIT (%ASCIZ' [Interrupted]')) ELSE TT_TEXT (UPLIT (%ASCIZ' [Interrupted, partial file saved]')) ELSE TT_TEXT (UPLIT (%ASCIZ' [OK]')); TT_CRLF (); END; IF NOT FILE_CLOSE (.DISCARD_FILE_FLAG AND .ABT_FLAG) THEN RETURN STATE_A; IF .DISCARD_FILE_FLAG THEN IF .ABT_FLAG THEN SUB_TYPE = %C'X' ELSE SUB_TYPE = %C'D' ELSE SUB_TYPE = %C'C'; END ELSE BEGIN TT_CRLF (); ! Make sure we have a CRLF TT_OUTPUT (); ! And make sure all output is sent END; XFR_STATUS (%C'F', .SUB_TYPE); MSG_NUMBER = (.MSG_NUMBER + 1) AND %O'77'; RETURN STATE_RF; END; [OTHERWISE] : BEGIN KRM_ERROR (KER_PROTOERR); RETURN STATE_A; END; TES; END; ! End of REC_DATA %SBTTL 'SERVER - Generic commands' ROUTINE SERVER_GENERIC = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the generic server messages. ! The generic server messages include FINISH, LOGOUT. ! ! CALLING SEQUENCE: ! ! STATE = SERVER_GENERIC(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! Generic message receive in REC_MSG. ! ! OUTPUT PARAMETERS: ! ! Returns new state for FSM ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS, ! Returned status G_FUNC, ! Generic command function POINTER, ! Character pointer DATA_TEXT : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Unpacked message DATA_SIZE; ! Actual size of data ROUTINE UNPACK_DATA (POINTER, SIZE, DST_ADDR, DST_LEN) = ! ! Routine to unpack an argument. ! This will copy the argument data to the desired buffer. ! BEGIN IF .SIZE GTR 0 ! If we have something to unpack THEN BEGIN .DST_LEN = UNCHAR (CH$RCHAR_A (.POINTER)); IF ..DST_LEN LSS 0 THEN BEGIN KRM_ERROR (KER_PROTOERR); ! Someone screwed up ..DST_LEN = 0; RETURN -1; END; IF ..DST_LEN GTR .SIZE - 1 THEN .DST_LEN = .SIZE - 1; CH$COPY (..DST_LEN, ..POINTER, CHR_NUL, MAX_MSG, CH$PTR (.DST_ADDR)); .POINTER = CH$PLUS (..POINTER, ..DST_LEN); RETURN .SIZE - ..DST_LEN - 1; END ELSE ! ! If nothing left in buffer, return the current size (0) ! RETURN .SIZE; END; ! ! First unpack the message data into its various pieces ! SET_STRING (CH$PTR (DATA_TEXT), MAX_MSG, TRUE); ! Initialize for unpacking BFR_EMPTY (); ! Unpack the data DATA_SIZE = SET_STRING (0, 0, FALSE); ! All done, get size IF .DATA_SIZE LEQ 0 THEN BEGIN KRM_ERROR (KER_PROTOERR); ! Someone screwed up RETURN STATE_A; ! Since no subtype END; ! ! Get the arguments from the unpacked data (if any) ! GEN_1SIZE = 0; ! Assume no args GEN_2SIZE = 0; ! none at all GEN_3SIZE = 0; CH$WCHAR (CHR_NUL, CH$PTR (GEN_1DATA)); ! Ensure all are null terminated CH$WCHAR (CHR_NUL, CH$PTR (GEN_2DATA)); CH$WCHAR (CHR_NUL, CH$PTR (GEN_3DATA)); POINTER = CH$PTR (DATA_TEXT, 1); ! Point at second character DATA_SIZE = .DATA_SIZE - 1; ! Account for subtype IF .DATA_SIZE GTR 0 ! Room for first arg? THEN BEGIN DATA_SIZE = UNPACK_DATA (POINTER, .DATA_SIZE, GEN_1DATA, GEN_1SIZE); IF .DATA_SIZE LSS 0 THEN RETURN STATE_A; ! Punt if bad arguments IF .DATA_SIZE GTR 0 ! Second argument present? THEN BEGIN DATA_SIZE = UNPACK_DATA (POINTER, .DATA_SIZE, GEN_2DATA, GEN_2SIZE); IF .DATA_SIZE LSS 0 THEN RETURN STATE_A; ! Punt if bad arguments IF .DATA_SIZE GTR 0 ! Third argument here? THEN BEGIN DATA_SIZE = UNPACK_DATA (POINTER, .DATA_SIZE, GEN_3DATA, GEN_3SIZE); IF .DATA_SIZE LSS 0 THEN RETURN STATE_A; ! Punt if bad arguments END; END; END; SELECTONE CH$RCHAR (CH$PTR (DATA_TEXT)) OF SET ! ! EXIT command, just return the status to the upper level ! [MSG_GEN_EXIT] : BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); RETURN STATE_FI; END; ! ! LOGOUT command, ACK the message then call the system routine to ! kill the process (log the job out, etc.) ! [MSG_GEN_LOGOUT] : BEGIN SEND_PACKET (MSG_ACK, 0, .REC_SEQ); SY_LOGOUT (); RETURN STATE_LG; END; ! ! For a type command, just set up a transfer flagging we want a text header ! instead of a file header. ! [MSG_GEN_TYPE] : BEGIN CH$COPY (.GEN_1SIZE, CH$PTR (GEN_1DATA), CHR_NUL, MAX_FILE_NAME, CH$PTR (FILE_NAME)); FILE_SIZE = .GEN_1SIZE; TEXT_HEAD_FLAG = TRUE; ! Now want text header XFR_STATUS (%C'I', %C'G'); ! Tell display routine we are doing a command IF .STATE EQL STATE_II AND .BLK_CHK_TYPE EQL .INI_CHK_TYPE THEN RETURN STATE_OF ! Must open the file ELSE RETURN STATE_S; ! Start the transaction with a send END; [MSG_GEN_DIRECTORY] : G_FUNC = GC_DIRECTORY; [MSG_GEN_DISK_USAGE] : G_FUNC = GC_DISK_USAGE; [MSG_GEN_DELETE] : G_FUNC = GC_DELETE; [MSG_GEN_HELP] : G_FUNC = GC_HELP; [MSG_GEN_LOGIN] : G_FUNC = GC_LGN; [MSG_GEN_CONNECT] : G_FUNC = GC_CONNECT; [MSG_GEN_RENAME] : G_FUNC = GC_RENAME; [MSG_GEN_COPY] : G_FUNC = GC_COPY; [MSG_GEN_WHO] : G_FUNC = GC_WHO; [MSG_GEN_SEND] : G_FUNC = GC_SEND_MSG; [MSG_GEN_QUERY] : G_FUNC = GC_STATUS; [MSG_GEN_PROGRAM] : G_FUNC = GC_PROGRAM; [MSG_GEN_JOURNAL] : G_FUNC = GC_JOURNAL; [MSG_GEN_VARIABLE] : G_FUNC = GC_VARIABLE; ! ! Here if we have a function that is not implemented in KERMSG. ! [OTHERWISE] : BEGIN KRM_ERROR (KER_UNIMPLGEN); RETURN STATE_A; END; TES; ! ! If we get here, we have gotten a known type of generic message that ! we need to have our operating system dependent routine handle. ! RETURN CALL_SY_RTN (.G_FUNC); END; ! End of SERVER_GENERIC %SBTTL 'HOST_COMMAND - perform a host command' ROUTINE HOST_COMMAND = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the host command packet. ! It will set up the data for the call to the system routine. ! ! CALLING SEQUENCE: ! ! STATE = HOST_COMMAND(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! Generic message receive in REC_MSG. ! ! OUTPUT PARAMETERS: ! ! Returns new state for FSM ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN GEN_1SIZE = 0; GEN_2SIZE = 0; GEN_3SIZE = 0; IF .REC_LENGTH LEQ 0 THEN BEGIN KRM_ERROR (KER_PROTOERR); ! Return an error RETURN STATE_A; ! Just abort END; SET_STRING (CH$PTR (GEN_1DATA), MAX_MSG, TRUE); ! Start writing to buffer BFR_EMPTY (); ! Dump the text GEN_1SIZE = SET_STRING (0, 0, FALSE); ! Get the result RETURN CALL_SY_RTN (GC_COMMAND); END; ! End of HOST_COMMAND %SBTTL 'KERMIT_COMMAND - perform a KERMIT command' ROUTINE KERMIT_COMMAND = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the KERMIT command packet. ! It will set up the data for the call to the system routine. ! ! CALLING SEQUENCE: ! ! STATE = KERMIT_COMMAND(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! Generic message receive in REC_MSG. ! ! OUTPUT PARAMETERS: ! ! Returns new state for FSM ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN GEN_1SIZE = 0; GEN_2SIZE = 0; GEN_3SIZE = 0; IF .REC_LENGTH LEQ 0 THEN BEGIN KRM_ERROR (KER_PROTOERR); ! Return an error RETURN STATE_A; ! Just abort END; SET_STRING (CH$PTR (GEN_1DATA), MAX_MSG, TRUE); ! Start writing to buffer BFR_EMPTY (); ! Dump the text GEN_1SIZE = SET_STRING (0, 0, FALSE); ! Get the result RETURN CALL_SY_RTN (GC_KERMIT); END; ! End of KERMIT_COMMAND %SBTTL 'CALL_SY_RTN - handle operating system dependent functions' ROUTINE CALL_SY_RTN (G_FUNC) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle calling the operating system dependent routine ! for a server function and returning the response. ! ! CALLING SEQUENCE: ! ! STATE = CALL_SY_RTN(.G_FUNC); ! ! INPUT PARAMETERS: ! ! G_FUNC - Generic function code ! ! IMPLICIT INPUTS: ! ! Generic message data in GEN_1DATA ! ! OUTPUT PARAMETERS: ! ! Returns new state for FSM ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STRING_ADDRESS, ! Address of string result STRING_LENGTH, ! Length of string result GET_CHR_SUBROUTINE, ! Routine to get a response character STATUS; ! Status value ! ! Call the routine with the desired type of command. ! STRING_LENGTH = 0; ! Initialize for no string GET_CHR_SUBROUTINE = 0; ! And no subroutine IF NOT SY_GENERIC (.G_FUNC, STRING_ADDRESS, STRING_LENGTH, GET_CHR_SUBROUTINE) THEN RETURN STATE_A; ! And abort IF .STRING_LENGTH GTR 0 THEN BEGIN SET_STRING (CH$PTR (.STRING_ADDRESS), .STRING_LENGTH, TRUE); IF .STRING_LENGTH LSS .SEND_PKT_SIZE - PKT_OVR_HEAD THEN BEGIN BFR_FILL (TRUE); ! If it should fit, pack it in IF SET_STRING (0, 0, FALSE) GEQ .STRING_LENGTH THEN ! It fit, so just send the ACK IF SEND_PACKET (MSG_ACK, .SIZE, .REC_SEQ) THEN RETURN STATE_C ELSE RETURN STATE_EX; ! ! It didn't fit, reset the pointers to the beginning ! SET_STRING (CH$PTR (.STRING_ADDRESS), .STRING_LENGTH, TRUE); END; NO_FILE_NEEDED = TRUE; ! Don't need a file END ELSE IF .GET_CHR_SUBROUTINE NEQ 0 ! If we got a subroutine back THEN BEGIN GET_CHR_ROUTINE = .GET_CHR_SUBROUTINE; NO_FILE_NEEDED = TRUE; END; TEXT_HEAD_FLAG = TRUE; ! Send to be typed XFR_STATUS (%C'I', %C'G'); ! Doing a generic command IF .STATE EQL STATE_II AND .BLK_CHK_TYPE EQL .INI_CHK_TYPE THEN RETURN STATE_OF ELSE RETURN STATE_S; ! Send the response END; ! End of CALL_SY_RTN %SBTTL 'Message processing -- PRS_SEND_INIT - Parse send init params' ROUTINE PRS_SEND_INIT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will parse the SEND_INIT parameters that were sent by ! the remote Kermit. The items will be stored into the low segment. ! ! CALLING SEQUENCE: ! ! PRS_SEND_INIT (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! Message stored in REC_MSG. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! The following section of code will parse the various send parameters ! that are found in the send-init message. The following code will store ! the following as the value. ! ! If the user specified a value then the user supplied value will be used else ! the value in the message and if none in the message then the default value. ! ! User supplied values are denoted as positive values in SND_xxxxxxx. ! ! Parse the packet size ! SEND_PKT_SIZE = (IF .SND_PKT_SIZE GEQ 0 THEN ! [108] (IF .SND_PKT_SIZE GTR 94 THEN 94 ELSE .SND_PKT_SIZE) ELSE ! [108] BEGIN IF .REC_LENGTH GTR P_SI_BUFSIZ THEN UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG + P_SI_BUFSIZ, CHR_SIZE))) ! [108] ELSE ABS (.SND_PKT_SIZE) END ); ! ! Parse the time out value ! SEND_TIMEOUT = (IF .SND_TIMEOUT GEQ 0 THEN .SND_TIMEOUT ELSE BEGIN IF .REC_LENGTH GTR P_SI_TIMOUT THEN UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG + P_SI_TIMOUT, CHR_SIZE))) ! [108] ELSE ABS (.SND_TIMEOUT) END ); ! ! Parse the number of padding characters supplied ! SEND_NPAD = (IF .SND_NPAD GEQ 0 THEN .SND_NPAD ELSE BEGIN IF .REC_LENGTH GTR P_SI_NPAD THEN UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG + P_SI_NPAD, CHR_SIZE))) ! [108] ELSE ABS (.SND_NPAD) END ); ! ! Parse the padding character ! SEND_PADCHAR = (IF .SND_PADCHAR GEQ 0 THEN .SND_PADCHAR ELSE BEGIN IF .REC_LENGTH GTR P_SI_PAD THEN CTL (CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG + P_SI_PAD, CHR_SIZE))) ! [108] ELSE ABS (.SND_PADCHAR) END ); ! ! Parse the end of line character ! SEND_EOL = (IF .SND_EOL GEQ 0 THEN .SND_EOL ELSE BEGIN IF .REC_LENGTH GTR P_SI_EOL THEN UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG + P_SI_EOL, CHR_SIZE))) ! [108] ELSE ABS (.SND_EOL) END ); ! ! Parse the quoting character ! SEND_QUOTE_CHR = (IF .SND_QUOTE_CHR GEQ 0 THEN .SND_QUOTE_CHR ELSE BEGIN IF .REC_LENGTH GTR P_SI_QUOTE THEN CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG + P_SI_QUOTE, ! [108] CHR_SIZE)) ELSE ABS (.SND_QUOTE_CHR) END ); ! ! Parse the 8-bit quoting character ! ! If the character was not included in the packet, assume no eight-bit ! quoting allowed (we are probably talking to an old version of Kermit). ! SEND_8QUOTE_CHR = (IF .REC_LENGTH GTR P_SI_8QUOTE THEN CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG + P_SI_8QUOTE, CHR_SIZE)) ELSE %C'N' ! [108] ! Assume no 8-bit quoting allowed ); ! ! Parse the checksum type ! IF .REC_LENGTH GTR P_SI_CHKTYPE THEN BEGIN LOCAL REQ_CHK_TYPE; REQ_CHK_TYPE = CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG + ! [108] P_SI_CHKTYPE, CHR_SIZE)); IF .REC_TYPE NEQ MSG_ACK THEN IF .REQ_CHK_TYPE GEQ CHK_1CHAR AND .REQ_CHK_TYPE LEQ CHK_CRC THEN INI_CHK_TYPE = .REQ_CHK_TYPE ELSE INI_CHK_TYPE = CHK_1CHAR ELSE IF .REQ_CHK_TYPE NEQ .CHKTYPE THEN INI_CHK_TYPE = CHK_1CHAR ELSE INI_CHK_TYPE = .REQ_CHK_TYPE END ELSE INI_CHK_TYPE = CHK_1CHAR; ! Only single character checksum if not specified ! ! Parse the repeat character ! REPT_CHR = (IF .REC_LENGTH GTR P_SI_REPEAT THEN CH$RCHAR (CH$PTR (REC_MSG, .RECV_PKT_MSG + P_SI_REPEAT, CHR_SIZE)) ELSE %C' '); ! [108] ! ! [108] ! Parse the capas field, if present and if we enabled extended length ! [108] ! ! [108] ! [108] IF (.REC_LENGTH GTR P_SI_CAPAS) AND (ABS(.SND_PKT_SIZE) GTR 94) ! [108] THEN ! [108] BEGIN ! [108] ! [108] LOCAL ! [108] CAPAS_OFFSET; ! [108] ! [108] CAPAS_OFFSET = .RECV_PKT_MSG + P_SI_CAPAS; ! [108] IF (UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, .CAPAS_OFFSET, CHR_SIZE))) AND 2) NEQ 0 THEN ! [108] BEGIN ! [108] ! [108] SEND_PKT_SIZE = 500; ! [108] ! [108] WHILE (.REC_LENGTH GTR .CAPAS_OFFSET-.RECV_PKT_MSG) AND ! [108] ((UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, .CAPAS_OFFSET, ! [108] CHR_SIZE))) AND 1) EQL 1) DO ! [108] BEGIN ! [108] CAPAS_OFFSET = .CAPAS_OFFSET + 1; ! [108] END; ! [108] IF .REC_LENGTH GTR .CAPAS_OFFSET-.RECV_PKT_MSG+3 ! [108] THEN ! [108] SEND_PKT_SIZE = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, ! [108] .CAPAS_OFFSET+2, CHR_SIZE))) * 95 + UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, ! [108] .CAPAS_OFFSET+3, CHR_SIZE))); ! [108] IF .SEND_PKT_SIZE GTR MAX_MSG - 2 ! [108] THEN ! [108] SEND_PKT_SIZE = MAX_MSG - 2; ! [108] IF .SEND_PKT_SIZE GTR ABS(.SND_PKT_SIZE) ! [108] THEN ! [108] SEND_PKT_SIZE = ABS(.SND_PKT_SIZE); ! [108] END; ! [108] END; ! [108] ! ! Check for a valid quoting character. If it is not valid, then we have ! a protocol error ! IF NOT ((.SEND_QUOTE_CHR GEQ %O'41' AND .SEND_QUOTE_CHR LEQ %O'76') OR (.SEND_QUOTE_CHR GEQ %O '140' AND .SEND_QUOTE_CHR LEQ %O'176')) THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN KER_PROTOERR; END; ! ! Check for a valid 8 bit quoting and set the 8 bit quoting flag as needed ! IF ( NOT ((.SEND_8QUOTE_CHR GEQ %O'041' AND .SEND_8QUOTE_CHR LEQ %O'076') OR (.SEND_8QUOTE_CHR GEQ %O'140' AND .SEND_8QUOTE_CHR LEQ %O'176') OR (.SEND_8QUOTE_CHR EQL %C'N') OR ( .SEND_8QUOTE_CHR EQL %C'Y'))) OR .SEND_8QUOTE_CHR EQL .SEND_QUOTE_CHR OR .SEND_8QUOTE_CHR EQL .RCV_QUOTE_CHR THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN KER_PROTOERR; END; IF .SEND_8QUOTE_CHR EQL %C'Y' THEN SEND_8QUOTE_CHR = .RECV_8QUOTE_CHR; IF .SEND_8QUOTE_CHR NEQ %C'N' AND .SEND_8QUOTE_CHR NEQ %C'Y' THEN FLAG_8QUOTE = TRUE ELSE FLAG_8QUOTE = FALSE; ! ! Check the repeat character and set flags ! IF ( NOT ((.REPT_CHR GEQ %O'41' AND .REPT_CHR LEQ %O'76') OR (.REPT_CHR GEQ %O'140' AND .REPT_CHR LEQ %O'176')) OR .REPT_CHR EQL .SEND_QUOTE_CHR OR .REPT_CHR EQL .SEND_8QUOTE_CHR OR .REPT_CHR EQL .RCV_QUOTE_CHR) AND .REPT_CHR NEQ %C' ' THEN BEGIN KRM_ERROR (KER_PROTOERR); RETURN KER_PROTOERR; END; IF .REPT_CHR NEQ %C' ' THEN FLAG_REPEAT = TRUE ELSE FLAG_REPEAT = FALSE; RETURN KER_NORMAL; END; ! End of PRS_SEND_INIT %SBTTL 'SET_SEND_INIT' ROUTINE SET_SEND_INIT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the various parameters for the ! MSG_SND_INIT message. ! ! CALLING SEQUENCE: ! ! SET_SEND_INIT(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! SND_MSG parameters set up. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN CH$WCHAR (CHAR ((IF .RCV_PKT_SIZE LSS 94 THEN .RCV_PKT_SIZE ELSE 94)), CH$PTR (SND_MSG, PKT_MSG + P_SI_BUFSIZ, CHR_SIZE)); ! [108] CH$WCHAR (CHAR (.RCV_TIMEOUT), CH$PTR (SND_MSG, PKT_MSG + P_SI_TIMOUT, CHR_SIZE)); CH$WCHAR (CHAR (.RCV_NPAD), CH$PTR (SND_MSG, PKT_MSG + P_SI_NPAD, CHR_SIZE)); CH$WCHAR (CTL (.RCV_PADCHAR), CH$PTR (SND_MSG, PKT_MSG + P_SI_PAD, CHR_SIZE)); CH$WCHAR (CHAR (.RCV_EOL), CH$PTR (SND_MSG, PKT_MSG + P_SI_EOL, CHR_SIZE)); CH$WCHAR (.RCV_QUOTE_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_QUOTE, CHR_SIZE)); CH$WCHAR (.SEND_8QUOTE_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_8QUOTE, CHR_SIZE)); CH$WCHAR (.INI_CHK_TYPE, CH$PTR (SND_MSG, PKT_MSG + P_SI_CHKTYPE, CHR_SIZE)); CH$WCHAR (.REPT_CHR, CH$PTR (SND_MSG, PKT_MSG + P_SI_REPEAT, CHR_SIZE)); SEND_INIT_SIZE = P_SI_LENGTH; ! [108] IF .RCV_PKT_SIZE GTR 94 ! [108] THEN ! [108] BEGIN ! [108] CH$WCHAR (CHAR (EXTLEN_CAPAS), CH$PTR (SND_MSG, PKT_MSG + P_SI_CAPAS, CHR_SIZE)); CH$WCHAR (CHAR (0), CH$PTR (SND_MSG, PKT_MSG + P_SI_WINDO, CHR_SIZE)); CH$WCHAR (CHAR (.RCV_PKT_SIZE/95), CH$PTR (SND_MSG, PKT_MSG + P_SI_MAXLX1, CHR_SIZE)); CH$WCHAR (CHAR (.RCV_PKT_SIZE MOD 95), CH$PTR (SND_MSG, PKT_MSG + P_SI_MAXLX2, CHR_SIZE)); ! [108] SEND_INIT_SIZE = P_SI_XLENGTH; ! [108] END; ! [108] END; ! End of SET_SEND_INIT %SBTTL 'SEND_PACKET' ROUTINE SEND_PACKET (TYPE, LENGTH, MN) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will cause a packet to be sent over the line ! that has been opened by OPEN_TERMINAL. ! ! CALLING SEQUENCE: ! ! SEND_PACKET(Type, Length); ! ! INPUT PARAMETERS: ! ! TYPE - Type of packet to send. ! ! LENGTH - Length of the packet being sent. ! [108] Negative length means it's an extended length packet ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL FILLER : VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)], TOT_MSG_LEN, ! Length of message including all characters CHKSUM, ! Checksum for the message we calculate POINTER; ! Pointer to the information in the message ! ! Do any filler processing that the remote KERMIT requires. ! IF .SEND_NPAD NEQ 0 THEN BEGIN CH$FILL (.SEND_PADCHAR, MAX_MSG, CH$PTR (FILLER, 0, CHR_SIZE)); ! ! Update the send stats ! SMSG_TOTAL_CHARS = .SMSG_TOTAL_CHARS + .SEND_NPAD; ! ! Send the fill ! DO_PARITY (FILLER, .SEND_NPAD + PKT_TOT_OVR_HEAD); SEND (FILLER, .SEND_NPAD + PKT_TOT_OVR_HEAD); END; ! ! Store the header information into the message. ! CH$WCHAR (.TYPE, CH$PTR (SND_MSG, PKT_TYPE, CHR_SIZE)); CH$WCHAR (.SND_SOH, CH$PTR (SND_MSG, PKT_MARK, CHR_SIZE)); CH$WCHAR (CHAR (IF .MN LSS 0 THEN 0 ELSE .MN), CH$PTR (SND_MSG, PKT_SEQ, CHR_SIZE)); IF .LENGTH LSS 0 ! [108] THEN ! [108] BEGIN ! [108] TOT_MSG_LEN = PKT_OVR_HEAD + 3 - .LENGTH; ! [108] CH$WCHAR (CHAR (0), CH$PTR (SND_MSG, PKT_COUNT, CHR_SIZE)); ! [108] CH$WCHAR (CHAR ((.TOT_MSG_LEN - PKT_HCHECK + 1 + ! [108] (.BLK_CHK_TYPE - CHK_1CHAR)) / 95), ! [108] CH$PTR (SND_MSG, PKT_COUNTX1, CHR_SIZE)); ! [108] CH$WCHAR (CHAR ((.TOT_MSG_LEN - PKT_HCHECK + 1 + ! [108] (.BLK_CHK_TYPE - CHK_1CHAR)) MOD 95), ! [108] CH$PTR (SND_MSG, PKT_COUNTX2, CHR_SIZE)); ! [108] POINTER = CH$PTR(SND_MSG, PKT_SEQ, CHR_SIZE); ! [108] CHKSUM = CHAR (0) + CH$RCHAR_A (POINTER); ! [108] CHKSUM = .CHKSUM + CH$RCHAR_A (POINTER); ! [108] CHKSUM = .CHKSUM + CH$RCHAR_A (POINTER); ! [108] CHKSUM = .CHKSUM + CH$RCHAR_A (POINTER); ! [108] CH$WCHAR (CHAR ((.CHKSUM + ((.CHKSUM AND %O'300')/%O'100')) AND %O'77'), CH$PTR (SND_MSG, PKT_HCHECK, CHR_SIZE)); ! [108] END ! [108] ELSE ! [108] BEGIN ! [108] TOT_MSG_LEN = PKT_OVR_HEAD + .LENGTH; ! [108] CH$WCHAR (CHAR (.TOT_MSG_LEN + (.BLK_CHK_TYPE - CHK_1CHAR)), ! [108] CH$PTR (SND_MSG, PKT_COUNT, CHR_SIZE)); END; ! [108] ! ! Calculate the block check value ! POINTER = CH$PTR (SND_MSG, PKT_MARK + 1, CHR_SIZE); CHKSUM = CALC_BLOCK_CHECK (.POINTER, .TOT_MSG_LEN); ! [108] ! ! Store the checksum into the message ! POINTER = CH$PTR (SND_MSG, .TOT_MSG_LEN + 1, CHR_SIZE); ! [108] CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF SET [CHK_1CHAR] : CH$WCHAR_A (CHAR (.CHKSUM), POINTER); [CHK_2CHAR] : BEGIN CH$WCHAR_A (CHAR (.CHKSUM<6, 6>), POINTER); CH$WCHAR_A (CHAR (.CHKSUM<0, 6>), POINTER); TOT_MSG_LEN = .TOT_MSG_LEN + 1; END; [CHK_CRC] : BEGIN CH$WCHAR_A (CHAR (.CHKSUM<12, 4>), POINTER); CH$WCHAR_A (CHAR (.CHKSUM<6, 6>), POINTER); CH$WCHAR_A (CHAR (.CHKSUM<0, 6>), POINTER); TOT_MSG_LEN = .TOT_MSG_LEN + 2; END; TES; ! ! Store in the end of line character ! CH$WCHAR_A (.SEND_EOL, POINTER); ! ! If we are debugging then type out the message we are sending. ! DBG_SEND (SND_MSG, (.TOT_MSG_LEN + PKT_TOT_OVR_HEAD - PKT_OVR_HEAD));! [108] ! ! Update the stats for total characters and the data characters ! SMSG_TOTAL_CHARS = .SMSG_TOTAL_CHARS + .TOT_MSG_LEN + PKT_TOT_OVR_HEAD - PKT_OVR_HEAD; ! [108] ! Make data characters really be that, not just characters in data field ! SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .LENGTH; IF .TYPE EQL MSG_NAK THEN BEGIN SMSG_NAKS = .SMSG_NAKS + 1; XFR_STATUS (%C'S', %C'N'); END ELSE BEGIN SMSG_COUNT = .SMSG_COUNT + 1; XFR_STATUS (%C'S', %C'P'); END; ! ! Check if we are in IBM mode and need to wait for an XON first ! We will not wait if this is a packet which might be going out ! without previous traffic (generic commands, init packets). IF (.IBM_CHAR GEQ 0) ! If handshaking on THEN IF NOT IBM_WAIT () THEN RETURN KER_ABORTED; ! ! Now call the O/S routine to send the message out to the remote KERMIT ! DO_PARITY (SND_MSG, .TOT_MSG_LEN + PKT_TOT_OVR_HEAD - PKT_OVR_HEAD); ! [108] RETURN SEND (SND_MSG, .TOT_MSG_LEN + PKT_TOT_OVR_HEAD - PKT_OVR_HEAD); ! [108] END; ! End of SEND_PACKET %SBTTL 'REC_MESSAGE - Receive a message' ROUTINE REC_MESSAGE (CHK_ROUTINE) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the retry processing for the various ! messages that can be received. ! ! CALLING SEQUENCE: ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! KER_NORMAL - Normal return ! KER_RETRIES - Too many retries ! (What ever REC_PACKET returns). ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS; ! Status returned by various routines RETURN WHILE TRUE DO BEGIN IF .NUM_RETRIES GTR .PKT_RETRIES THEN BEGIN KRM_ERROR (KER_RETRIES); ! Report the error RETURN KER_RETRIES; END; NUM_RETRIES = .NUM_RETRIES + 1; STATUS = REC_PACKET (); ![043] Don't abort on errors which might just be due to noise. IF NOT .STATUS AND .STATUS NEQ KER_CHKSUMERR AND .STATUS NEQ KER_TIMEOUT AND .STATUS NEQ KER_ZEROLENMSG THEN RETURN .STATUS; IF NOT .STATUS THEN SEND_PACKET (MSG_NAK, 0, .MSG_NUMBER) ![024] ELSE BEGIN ![021] ![021] If the packet type is not acceptable by our caller, nak it so the ![021] other end tries again, and abort the current operation. This is so ![021] we will return to server mode (if we are running that way) quickly ![021] when the other Kermit has been aborted and then restarted, and should ![021] also make restarting quick, since we will not need to wait for the ![021] other Kermit to time this message out before retransmitting. ![021] IF NOT (.CHK_ROUTINE) () THEN BEGIN SEND_PACKET (MSG_NAK, 0, .REC_SEQ); RETURN FALSE; ! Just indicate an error END ELSE EXITLOOP KER_NORMAL; END; END; END; ! End of REC_PARSE %SBTTL 'REC_PACKET' ROUTINE REC_PACKET = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will do the oppoiste of SEND_PACKET. It will wait ! for the message to be read from the remote and then it will ! check the message for validity. ! ! CALLING SEQUENCE: ! ! Flag = REC_PACKET(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! REC_MSG - Contains the message received. ! ! COMPLETION CODES: ! ! True - Packet receive ok. ! False - Problem occured during the receiving of the packet. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN BIND ATTEMPT_TEXT = UPLIT (%ASCIZ'Attempting to receive'); LOCAL STATUS, ! Status returned by various routines MSG_LENGTH, ERR_POINTER, ! Pointer to the error buffer POINTER, CHKSUM; ! Checksum of the message ! ! Attempt to read the message from the remote. ! ! DO ! BEGIN IF .DEBUG_FLAG THEN BEGIN LOCAL OLD_RTN; OLD_RTN = TT_SET_OUTPUT (DBG_DUMP); TT_TEXT (ATTEMPT_TEXT); TT_CRLF (); TT_SET_OUTPUT (.OLD_RTN); END; ! ! If status type out requested, do it once ! IF .TYP_STS_FLAG THEN BEGIN STS_OUTPUT (); TYP_STS_FLAG = FALSE; END; ! ! Receive the message from the remote Kermit ! STATUS = RECEIVE (REC_MSG, MSG_LENGTH); ! ! Check for timeouts ! IF .STATUS EQL KER_TIMEOUT THEN XFR_STATUS (%C'R', %C'T'); ! ! If it failed return the status to the upper level ! IF NOT .STATUS THEN BEGIN IF .STATUS NEQ KER_ABORTED AND .STATUS NEQ KER_TIMEOUT THEN KRM_ERROR (.STATUS); ! Report error RETURN .STATUS; END; ! ! Determine if we got a good message ! IF .MSG_LENGTH LSS PKT_TOT_OVR_HEAD - 1 THEN BEGIN RETURN KER_ZEROLENMSG; END; IF UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNT, CHR_SIZE))) EQL 0 ! [108] THEN ! [108] BEGIN ! [108] IF .MSG_LENGTH LSS PKT_TOT_OVR_HEAD - 1 + 3 ! [108] THEN ! [108] BEGIN ! [108] RETURN KER_ZEROLENMSG; ! [108] END; ! [108] END; ! [108] ! ! Update the stats on the total number of characters received. ! RMSG_TOTAL_CHARS = .RMSG_TOTAL_CHARS + .MSG_LENGTH; ! ! Initialize the checksum and others ! REC_TYPE = CH$RCHAR (CH$PTR (REC_MSG, PKT_TYPE, CHR_SIZE)); ! ! Now break the message apart byte by byte. ! RECV_PKT_MSG = PKT_MSG; ! [108] REC_LENGTH = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNT, CHR_SIZE))); IF .REC_LENGTH EQL 0 ! [108] THEN ! [108] BEGIN ! [108] REC_LENGTH = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNTX1, CHR_SIZE))) * 95 + UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_COUNTX2, CHR_SIZE))) + PKT_HCHECK - 1; ! [108] RECV_PKT_MSG = PKT_MSGX; ! [108] END; ! [108] REC_SEQ = UNCHAR (CH$RCHAR (CH$PTR (REC_MSG, PKT_SEQ, CHR_SIZE))); ! ! Typed the packet if we are debugging ! DBG_RECEIVE (REC_MSG); ! ! Now compute the final checksum and make sure that it is identical ! to what we received from the remote KERMIT ! POINTER = CH$PTR (REC_MSG, PKT_MARK + 1, CHR_SIZE); REC_LENGTH = .REC_LENGTH - (.BLK_CHK_TYPE - CHK_1CHAR); ! [108] CHKSUM = CALC_BLOCK_CHECK (.POINTER, .REC_LENGTH); ! [108] POINTER = CH$PTR (REC_MSG, .REC_LENGTH + 1, CHR_SIZE); ! [108] REC_LENGTH = .REC_LENGTH - .RECV_PKT_MSG + 1; ! [108] STATUS = KER_NORMAL; ! Assume good checksum CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF SET [CHK_1CHAR] : IF .CHKSUM NEQ UNCHAR (CH$RCHAR_A (POINTER)) THEN STATUS = KER_CHKSUMERR; [CHK_2CHAR] : IF (.CHKSUM<6, 6> NEQ UNCHAR (CH$RCHAR_A (POINTER))) OR (.CHKSUM<0, 6> NEQ UNCHAR ( CH$RCHAR_A (POINTER))) THEN STATUS = KER_CHKSUMERR; [CHK_CRC] : IF (.CHKSUM<12, 4> NEQ UNCHAR (CH$RCHAR_A (POINTER))) OR (.CHKSUM<6, 6> NEQ UNCHAR ( CH$RCHAR_A (POINTER))) OR (.CHKSUM<0, 6> NEQ UNCHAR (CH$RCHAR_A (POINTER))) THEN STATUS = KER_CHKSUMERR; TES; ! ! If we have a bad checksum, check for the special cases when we might be out ! of sync with the sender. This can occur if the sender is retransmitting ! a send-init (because our ACK got lost), and we have agreed on multi-char ! checksums, or because the sender is a server who has aborted back to being ! idle without telling us. ! Note that in either case, we return back to using single character checksums ! IF .STATUS EQL KER_CHKSUMERR THEN BEGIN IF (.BLK_CHK_TYPE NEQ CHK_1CHAR AND .REC_SEQ EQL 0) AND (.REC_LENGTH LSS 1 - (.BLK_CHK_TYPE - CHK_1CHAR) AND .REC_TYPE EQL MSG_NAK) OR (.REC_TYPE EQL MSG_SND_INIT) THEN BEGIN LOCAL SAVE_BLK_CHK_TYPE; SAVE_BLK_CHK_TYPE = .BLK_CHK_TYPE; ! Remember what we are using BLK_CHK_TYPE = CHK_1CHAR; POINTER = CH$PTR (REC_MSG, PKT_MARK + 1, CHR_SIZE); CHKSUM = CALC_BLOCK_CHECK (.POINTER, .REC_LENGTH + .RECV_PKT_MSG - 1); ! [108] POINTER = CH$PTR (REC_MSG, .REC_LENGTH + PKT_OVR_HEAD + 1, CHR_SIZE); IF .CHKSUM NEQ UNCHAR (CH$RCHAR_A (POINTER)) THEN BEGIN BLK_CHK_TYPE = .SAVE_BLK_CHK_TYPE; RETURN KER_CHKSUMERR; END; END ELSE RETURN KER_CHKSUMERR; END; ! ! Update the stats ! ! RMSG_DATA_CHARS = .RMSG_DATA_CHARS + .REC_LENGTH; IF .REC_TYPE EQL MSG_NAK THEN BEGIN RMSG_NAKS = .RMSG_NAKS + 1; XFR_STATUS (%C'R', %C'N'); END ELSE BEGIN RMSG_COUNT = .RMSG_COUNT + 1; XFR_STATUS (%C'R', %C'P'); END; ! ! Now check to see if we have an E type (Error) packet. ! IF .REC_TYPE NEQ MSG_ERROR THEN RETURN KER_NORMAL; ! ! Here to process an error packet. Call the user routine to output the ! error message to the terminal. ! ! ![026] Use decoding routine to fetch the error text ! CH$FILL (CHR_NUL, MAX_MSG + 1, CH$PTR (LAST_ERROR)); SET_STRING (CH$PTR (LAST_ERROR), MAX_MSG, TRUE); BFR_EMPTY (); SET_STRING (0, 0, FALSE); ![026] ERR_POINTER = CH$PTR (LAST_ERROR); ![026] POINTER = CH$PTR (REC_MSG, PKT_MSG, CHR_SIZE); ![026] ![026] INCR I FROM 1 TO .REC_LENGTH DO ![026] CH$WCHAR_A (CH$RCHAR_A (POINTER), ERR_POINTER); ![026] ![026] CH$WCHAR (CHR_NUL, ERR_POINTER); TT_TEXT (LAST_ERROR); TT_CRLF (); RETURN KER_ERRMSG; END; ! End of REC_PACKET %SBTTL 'CALC_BLOCK_CHECK' ROUTINE CALC_BLOCK_CHECK (POINTER, LENGTH) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will calculate the proper value for the block check ! for a given message. The value it returns is dependant upon the ! type of block check requested in BLK_CHK_TYPE. ! ! CALLING SEQUENCE: ! ! CHKSUM = CALC_BLOCK_CHECK (.POINTER, .LENGTH); ! ! INPUT PARAMETERS: ! ! POINTER - A character pointer to the first character to be ! included in the block check. ! ! LENGTH - The number of characters to be included. ! ! IMPLICIT INPUTS: ! ! BLK_CHK_TYPE - The type of block check to generate. ! ! OUPTUT PARAMETERS: ! ! The value is the block check. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL CHAR_MASK, ! Mask for stripping bits BLOCK_CHECK; ! To build initial block check value BLOCK_CHECK = 0; ! Start out at 0 ! ! Set mask for characters so that we calculate the block check correctly ! CHAR_MASK = (IF .PARITY_TYPE EQL PR_NONE THEN %O'377' ELSE %O'177'); CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF SET [CHK_1CHAR, CHK_2CHAR] : INCR I FROM 1 TO .LENGTH DO BLOCK_CHECK = .BLOCK_CHECK + (CH$RCHAR_A (POINTER) AND .CHAR_MASK); [CHK_CRC] : BEGIN ! ! Ensure that the calculation is done with correct type of characters ! LOCAL TMP_PTR; ! Temp pointer for copying chars TMP_PTR = .POINTER; IF .PARITY_TYPE NEQ PR_NONE THEN INCR I FROM 1 TO .LENGTH DO CH$WCHAR_A ((CH$RCHAR (.TMP_PTR) AND %O'177'), TMP_PTR); BLOCK_CHECK = CRCCLC (.POINTER, .LENGTH); END; TES; IF .BLK_CHK_TYPE EQL CHK_1CHAR THEN BLOCK_CHECK = (.BLOCK_CHECK + ((.BLOCK_CHECK AND %O'300')/%O'100')) AND %O'77'; RETURN .BLOCK_CHECK; ! Return the correct value END; ! End of CALC_BLOCK_CHK %SBTTL 'NORMALIZE_FILE - Put file name into normal form' ROUTINE NORMALIZE_FILE (FILE_ADDRESS, FILE_LENGTH, NAME_LENGTH, TYPE_LENGTH) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will ensure that a file specification is in normal ! form. It does this by replacing all non-alphanumeric characters ! (except the first period) with "X". It will also ensure that ! the resulting specification (of form name.type) has only ! a specified number of characters in the name portion and type portion. ! ! CALLING SEQUENCE: ! ! NORMALIZE_FILE (FILE_ADDRESS, FILE_LENGTH, NAME_LENGTH, TYPE_LENGTH); ! ! INPUT PARAMETERS: ! ! FILE_ADDRESS - Address of file specification string to be normalized ! ! FILE_LENGTH - Length of file specification ! ! NAME_LENGTH - Maximum length desired for "name" portion. ! ! TYPE_LENGTH - Maximum length desired for "type" portion. ! ! With both NAME_LENGTH and TYPE_LENGTH, a negative value indicates ! unlimited lenght. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! FILE_LENGTH - The length of the resulting file spec ! ! NAME_LENGTH - The actual length of the resulting file name ! ! TYPE_LENGTH - The actual length of the resulting file type ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL CH, ! Character being processed POINTER, ! Pointer to file spec WRT_POINTER, ! Pointer to write file spec WRT_SIZE, FIRST_PERIOD, ! Flag we have seen a period IGNORE_BAD, ! Flag we should ignore bad characters BAD_CHAR, ! Flag this character was bad FILE_CTR, ! Counter for overall length NAME_CTR, ! Counter for name characters TYPE_CTR; ! Counter for type characters FILE_CTR = 0; NAME_CTR = 0; TYPE_CTR = 0; WRT_SIZE = 0; FIRST_PERIOD = FALSE; ! No periods yet POINTER = CH$PTR (.FILE_ADDRESS); ! Set up pointer to file name WRT_POINTER = .POINTER; IF .NAME_LENGTH EQL 0 THEN FIRST_PERIOD = TRUE; ! Pretend we did name already IGNORE_BAD = FALSE; IF .NAME_LENGTH GTR 0 THEN BEGIN DECR I FROM ..FILE_LENGTH TO 0 DO IF CH$RCHAR_A (POINTER) EQL %C'.' THEN BEGIN IGNORE_BAD = TRUE; EXITLOOP; END; END; POINTER = .WRT_POINTER; WHILE .FILE_CTR LSS ..FILE_LENGTH DO BEGIN CH = CH$RCHAR_A (POINTER); ! Get a character FILE_CTR = .FILE_CTR + 1; IF (.CH LSS %C'0' AND (.CH NEQ %C'.' OR .FIRST_PERIOD)) OR .CH GTR %C'z' OR (.CH GTR %C'9' AND .CH LSS %C'A') OR (.CH GTR %C'Z' AND .CH LSS %C'a') THEN BEGIN BAD_CHAR = TRUE; CH = %C'X'; END ELSE BEGIN BAD_CHAR = FALSE; IF .CH GEQ %C'a' THEN CH = .CH - (%C'a' - %C'A'); END; IF .CH EQL %C'.' THEN BEGIN FIRST_PERIOD = TRUE; CH$WCHAR_A (.CH, WRT_POINTER); WRT_SIZE = .WRT_SIZE + 1; END ELSE IF NOT .BAD_CHAR OR NOT .IGNORE_BAD THEN IF NOT .FIRST_PERIOD THEN BEGIN IF .NAME_LENGTH LSS 0 OR .NAME_CTR LSS .NAME_LENGTH THEN BEGIN NAME_CTR = .NAME_CTR + 1; WRT_SIZE = .WRT_SIZE + 1; CH$WCHAR_A (.CH, WRT_POINTER); END; END ELSE IF .TYPE_LENGTH LSS 0 OR .TYPE_CTR LSS .TYPE_LENGTH THEN BEGIN TYPE_CTR = .TYPE_CTR + 1; WRT_SIZE = .WRT_SIZE + 1; CH$WCHAR_A (.CH, WRT_POINTER); END; END; .FILE_LENGTH = .WRT_SIZE; CH$WCHAR_A (CHR_NUL, WRT_POINTER); END; ! End of NORMALIZE_FILE %SBTTL 'Buffer filling -- Main routine' ROUTINE BFR_FILL (FIRST_FLAG) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will fill the buffer with data from the file. It ! will do all the quoting that is required. ! ! CALLING SEQUENCE: ! ! EOF_FLAG = BFR_FILL(.FIRST_FLAG); ! ! INPUT PARAMETERS: ! ! FIRST_FLAG - Flag whether first call for this file ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! True - Buffer filled may be at end of file. ! False - At end of file. ! ! IMPLICIT OUTPUTS: ! ! Number of characters stored in the buffer. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LITERAL NO_CHAR = -1, ! No character next EOF_CHAR = -2; ! EOF seen LOCAL I, ! Temp loop index MAX_SIZE, ! Maximum size of data POINTER; ! Pointer into the message buffer OWN NEXT_CHR, ! Saved character STATUS, ! Status value REPEAT_COUNT, ! Number of times character repeated CHAR_8_BIT, ! 8 bit character from file CHRS : VECTOR [5], ! String needed to represent character CHR_IDX, ! Index into CHRS OLD_CHAR_8_BIT, ! Previous 8-bit character OLD_CHRS : VECTOR [5], ! String for previous character OLD_CHR_IDX; ! Index for previous character ROUTINE GET_QUOTED_CHAR = ! ! This routine gets a character from the file and returns both ! the character and the string needed to represent the character ! if it needs quoting. ! BEGIN IF .NEXT_CHR GEQ 0 THEN BEGIN CHAR_8_BIT = .NEXT_CHR; NEXT_CHR = NO_CHAR; STATUS = KER_NORMAL; END ELSE IF .NEXT_CHR EQL NO_CHAR THEN STATUS = (.GET_CHR_ROUTINE) (CHAR_8_BIT) ELSE STATUS = KER_EOF; IF .STATUS EQL KER_NORMAL THEN BEGIN ! ! Determine if we should just quote the character ! Either: ! Character is a delete (177 octal) ! or Character is a control character (less than 40 octal) ! or Character is a quote character ! or Character is the repeat character and doing repeat compression ! or Character is an eight bit quote character and doing eight bit ! quoting. ! IF ((.CHAR_8_BIT AND %O'177') LSS %C' ') OR ((.CHAR_8_BIT AND %O'177') EQL CHR_DEL) OR ( (.CHAR_8_BIT AND %O'177') EQL .RCV_QUOTE_CHR) OR (.FLAG_REPEAT AND ((.CHAR_8_BIT AND %O'177') EQL .REPT_CHR)) OR (.FLAG_8QUOTE AND ((.CHAR_8_BIT AND %O'177') EQL .SEND_8QUOTE_CHR)) THEN BEGIN ! ! If the character is a control character or delete we must do a CTL(Character) ! so it is something that we can be sure we can send. ! IF ((.CHAR_8_BIT AND %O'177') LSS %C' ') OR ((.CHAR_8_BIT AND %O'177') EQL CHR_DEL) THEN CHRS [0] = CTL (.CHAR_8_BIT) ELSE CHRS [0] = .CHAR_8_BIT; CHR_IDX = 1; CHRS [1] = .RCV_QUOTE_CHR; ![035] Use character we said we would send END ELSE BEGIN CHR_IDX = 0; CHRS [0] = .CHAR_8_BIT; END; END ELSE IF .STATUS NEQ KER_EOF THEN KRM_ERROR (.STATUS); ! Report error RETURN .STATUS; END; ROUTINE GET_8_QUOTED_CHAR = ! ! This routine will get the quoted representation of a character ! (by calling GET_QUOTED_CHAR), and return the 8th-bit quoted ! representation. ! BEGIN IF (STATUS = GET_QUOTED_CHAR ()) EQL KER_NORMAL THEN BEGIN ! ! Determine if we must quote the eighth bit (parity bit on) ! IF (((.CHRS [0] AND %O'177') NEQ .CHRS [0]) AND .FLAG_8QUOTE) THEN BEGIN CHRS [0] = .CHRS [0] AND %O'177'; CHR_IDX = .CHR_IDX + 1; CHRS [.CHR_IDX] = .SEND_8QUOTE_CHR; END; END; RETURN .STATUS; END; ! ! Start of code for BFR_FILL ! ! Initialize pointer and count ! SIZE = 0; IF .SEND_PKT_SIZE GTR 94 ! [108] THEN ! [108] BEGIN ! [108] POINTER = CH$PTR (SND_MSG, PKT_MSGX, CHR_SIZE); ! [108] MAX_SIZE = .SEND_PKT_SIZE - PKT_MSGX + 1 - (.BLK_CHK_TYPE - CHK_1CHAR); END ! [108] ELSE ! [108] BEGIN ! [108] POINTER = CH$PTR (SND_MSG, PKT_MSG, CHR_SIZE); ! [108] MAX_SIZE = .SEND_PKT_SIZE - PKT_MSG + 1 - (.BLK_CHK_TYPE - CHK_1CHAR); END; ! [108] ! ! If last call got an error or eof, return it now ! IF NOT .FIRST_FLAG AND (.STATUS NEQ KER_NORMAL) THEN RETURN .STATUS; ! ! If first time for a file prime the pump with the first character. ! IF .FIRST_FLAG THEN BEGIN FIRST_FLAG = FALSE; NEXT_CHR = -1; ! No backed up character IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR (); IF .STATUS NEQ KER_NORMAL THEN RETURN .STATUS; OLD_CHAR_8_BIT = .CHAR_8_BIT; INCR OLD_CHR_IDX FROM 0 TO .CHR_IDX DO OLD_CHRS [.OLD_CHR_IDX] = .CHRS [.OLD_CHR_IDX]; OLD_CHR_IDX = .CHR_IDX; REPEAT_COUNT = 0; ! Character was not repeated yet ! Will always be incremented END; ! ! Otherwise, loop until we fill buffer ! WHILE .SIZE LSS .MAX_SIZE DO ! Normal exit is via an EXITLOOP BEGIN ! ! Check if we are doing run compression ! IF .FLAG_REPEAT THEN BEGIN ! ! Here with previous character in OLD_xxx. As long as we ! are getting the same character, just count the run. ! WHILE (.CHAR_8_BIT EQL .OLD_CHAR_8_BIT) AND (.REPEAT_COUNT LSS 94) DO BEGIN REPEAT_COUNT = .REPEAT_COUNT + 1; IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR (); IF .STATUS NEQ KER_NORMAL THEN IF .STATUS NEQ KER_EOF THEN CHAR_8_BIT = NO_CHAR ELSE BEGIN CHAR_8_BIT = EOF_CHAR; CHR_IDX = -1; END; END; IF .OLD_CHR_IDX + 1 + 2 LSS ((.OLD_CHR_IDX + 1)*.REPEAT_COUNT) THEN BEGIN IF .SIZE + .OLD_CHR_IDX + 1 + 2 GTR .MAX_SIZE THEN BEGIN IF .CHAR_8_BIT EQL .OLD_CHAR_8_BIT THEN BEGIN NEXT_CHR = .CHAR_8_BIT; REPEAT_COUNT = .REPEAT_COUNT - 1; END; IF .CHAR_8_BIT EQL EOF_CHAR THEN BEGIN NEXT_CHR = EOF_CHAR; ! Remember EOF for next time STATUS = KER_NORMAL; ! And give good return now END; EXITLOOP; END; OLD_CHRS [.OLD_CHR_IDX + 1] = CHAR (.REPEAT_COUNT); OLD_CHRS [.OLD_CHR_IDX + 2] = .REPT_CHR; OLD_CHR_IDX = .OLD_CHR_IDX + 2; ! ! Count the number of file characters this represents ! SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .REPEAT_COUNT - 1; FILE_CHARS = .FILE_CHARS + .REPEAT_COUNT - 1; REPEAT_COUNT = 1; ! Only one time for this string END; ! ! If we don't have enough room for this character, wait till next ! time. ! IF .SIZE + (.OLD_CHR_IDX + 1)*.REPEAT_COUNT GTR .MAX_SIZE THEN BEGIN ! If the next character is the same, the count will get incremented ! next time we enter, so back it off now. IF .CHAR_8_BIT EQL .OLD_CHAR_8_BIT THEN BEGIN NEXT_CHR = .CHAR_8_BIT; REPEAT_COUNT = .REPEAT_COUNT - 1; END; ! ! If this is the last character of the file, ! remember that for next time, but give good return now. ! IF .CHAR_8_BIT EQL EOF_CHAR THEN BEGIN NEXT_CHR = EOF_CHAR; STATUS = KER_NORMAL END; EXITLOOP; END; SMSG_DATA_CHARS = .SMSG_DATA_CHARS + .REPEAT_COUNT; FILE_CHARS = .FILE_CHARS + .REPEAT_COUNT; DECR REPEAT_COUNT FROM .REPEAT_COUNT TO 1 DO DECR I FROM .OLD_CHR_IDX TO 0 DO BEGIN CH$WCHAR_A (.OLD_CHRS [.I], POINTER); SIZE = .SIZE + 1; END; ! ! If we had to defer EOF condition, reactivate it now. ! IF (.CHAR_8_BIT EQL EOF_CHAR) THEN STATUS = KER_EOF; ! ! If we got an error (or EOF) then exit ! IF (.STATUS NEQ KER_NORMAL) THEN EXITLOOP; ! ! Otherwise, copy the character which broke the run ! OLD_CHAR_8_BIT = .CHAR_8_BIT; INCR OLD_CHR_IDX FROM 0 TO .CHR_IDX DO OLD_CHRS [.OLD_CHR_IDX] = .CHRS [.OLD_CHR_IDX]; OLD_CHR_IDX = .CHR_IDX; REPEAT_COUNT = 0; END ELSE ! ! Here if we are not doing run compression. We can do things much ! easier. ! BEGIN IF (.SIZE + .CHR_IDX + 1) GTR .MAX_SIZE THEN EXITLOOP; SMSG_DATA_CHARS = .SMSG_DATA_CHARS + 1; FILE_CHARS = .FILE_CHARS + 1; DECR CHR_IDX FROM .CHR_IDX TO 0 DO BEGIN CH$WCHAR_A (.CHRS [.CHR_IDX], POINTER); SIZE = .SIZE + 1; END; IF .FLAG_8QUOTE THEN STATUS = GET_8_QUOTED_CHAR () ELSE STATUS = GET_QUOTED_CHAR (); IF (.STATUS NEQ KER_NORMAL) THEN EXITLOOP; END; END; ! [108] Return negative size if we use extend packet format IF .SEND_PKT_SIZE GTR 94 ! [108] THEN ! [108] SIZE = -.SIZE; ! [108] ! ! Determine if we really stored anything into the buffer. ! IF .SIZE NEQ 0 THEN RETURN KER_NORMAL ELSE RETURN .STATUS; END; ! End of BFR_FILL %SBTTL 'BFR_EMPTY' ROUTINE BFR_EMPTY = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will empty the data from the REC_MSG message buffer ! to the file. It will process quoting characters. ! ! CALLING SEQUENCE: ! ! Flag = BFR_EMPTY(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! True - No problems writing the file. ! False - I/O error writing the file. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS, ! Status returned by various routines REPEAT_COUNT, ! Count of times to repeat character TURN_BIT_8_ON, ! If eight bit quoting COUNTER, ! Count of the characters left CHARACTER, ! Character we are processing POINTER; ! Pointer to the data POINTER = CH$PTR (REC_MSG, .RECV_PKT_MSG, CHR_SIZE); ! [108] COUNTER = 0; WHILE (.COUNTER LSS .REC_LENGTH) DO BEGIN CHARACTER = CH$RCHAR_A (POINTER); COUNTER = .COUNTER + 1; ! ! If the character is the repeat character (and we are doing repeat ! compression), then get the count. ! IF ((.CHARACTER EQL .REPT_CHR) AND .FLAG_REPEAT) THEN BEGIN REPEAT_COUNT = UNCHAR (CH$RCHAR_A (POINTER) AND %O'177'); CHARACTER = CH$RCHAR_A (POINTER); COUNTER = .COUNTER + 2; END ELSE REPEAT_COUNT = 1; ! ! If the character is an eight bit quoting character and we are doing eight ! bit quoting then turn on the flag so we turn the eighth bit on when we ! get the real character. ! IF ((.CHARACTER EQL .SEND_8QUOTE_CHR) AND .FLAG_8QUOTE) THEN BEGIN TURN_BIT_8_ON = TRUE; COUNTER = .COUNTER + 1; CHARACTER = CH$RCHAR_A (POINTER); END ELSE TURN_BIT_8_ON = FALSE; ! ! Now determine if we are quoting the character. If so then we must eat ! the quoting character and get the real character. ! IF .CHARACTER EQL .SEND_QUOTE_CHR ![035] Is this character other Kermit sends as quote? THEN BEGIN CHARACTER = CH$RCHAR_A (POINTER); COUNTER = .COUNTER + 1; ! ! Determine if we must undo what someone else has done to the character ! IF ((.CHARACTER AND %O'177') GEQ CTL (CHR_DEL)) AND ((.CHARACTER AND %O'177') LEQ CTL ( CHR_DEL) + %O'40') THEN CHARACTER = CTL (.CHARACTER); END; ! ! Turn on the eight bit if needed and then write the character out ! IF .TURN_BIT_8_ON THEN CHARACTER = .CHARACTER OR %O'200'; RMSG_DATA_CHARS = .RMSG_DATA_CHARS + .REPEAT_COUNT; FILE_CHARS = .FILE_CHARS + .REPEAT_COUNT; DECR REPEAT_COUNT FROM .REPEAT_COUNT TO 1 DO BEGIN STATUS = (.PUT_CHR_ROUTINE) (.CHARACTER); IF NOT .STATUS THEN RETURN .STATUS; END; END; RETURN KER_NORMAL; END; ! End of BFR_EMPTY %SBTTL 'Buffer filling and emptying subroutines' ROUTINE SET_STRING (POINTER, LENGTH, START) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is used to set up the buffer filling and emptying ! routines to use a string for input (or output) rather than ! the file I/O routines. ! ! CALLING SEQUENCE: ! ! SET_STRING (.POINTER, .LENGTH, .START) ! ! INPUT PARAMETERS: ! ! POINTER - Character pointer to string ! ! LENGTH - Number of characters in string ! ! START - True to start string, false to end it ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! Returns 0 if START = TRUE, actual number of characters used ! by last string if START = FALSE. ! ! IMPLICIT OUTPUTS: ! ! GET_CHR_ROUTINE and PUT_CHR_ROUTINE modifed so that string ! routines are called instead of file I/O. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN OWN STR_POINTER, ! Pointer to string STR_LENGTH, ! Length of string STR_ORG_LENGTH, ! Original length of string OLD_GET_CHR, ! Old get-char routine OLD_PUT_CHR; ! Old put-char routine ! ! Routine to get a character from the string ! ROUTINE GET_STRING (CHAR_ADDRESS) = BEGIN ! ! If some characters are left, count down the length and get next character ! Otherwise return and end of file indication. ! IF .STR_LENGTH GTR 0 THEN BEGIN STR_LENGTH = .STR_LENGTH - 1; .CHAR_ADDRESS = CH$RCHAR_A (STR_POINTER); RETURN KER_NORMAL; END ELSE RETURN KER_EOF; END; ! End of GET_STRING ROUTINE PUT_STRING (CHAR_VALUE) = BEGIN ! ! If there is enough room to store another character, store the character ! and count it. Otherwise return a line too long indication. ! IF .STR_LENGTH GTR 0 THEN BEGIN STR_LENGTH = .STR_LENGTH - 1; CH$WCHAR_A (.CHAR_VALUE, STR_POINTER); RETURN KER_NORMAL; END ELSE RETURN KER_LINTOOLNG; END; ! End of PUT_STRING ! ! If we have a request to start a string (input or output), save the old ! routines and set up ours. Also save the string pointer and length for ! use by our get/put routines. ! Otherwise this is a request to stop using the string routines, so reset ! the old routines and return the actual number of characters read or ! written ! IF .START THEN BEGIN STR_POINTER = .POINTER; STR_ORG_LENGTH = .LENGTH; STR_LENGTH = .LENGTH; OLD_GET_CHR = .GET_CHR_ROUTINE; OLD_PUT_CHR = .PUT_CHR_ROUTINE; GET_CHR_ROUTINE = GET_STRING; PUT_CHR_ROUTINE = PUT_STRING; RETURN 0; END ELSE BEGIN GET_CHR_ROUTINE = .OLD_GET_CHR; PUT_CHR_ROUTINE = .OLD_PUT_CHR; RETURN .STR_ORG_LENGTH - .STR_LENGTH; END; END; ! End of SET_STRING %SBTTL 'Add parity routine' ROUTINE DO_PARITY (MESSAGE, LENGTH) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will add parity for a complete message that is to be ! sent to the remote Kermit. ! ! CALLING SEQUENCE: ! ! DO_PARITY (Message_address, Message_length); ! ! INPUT PARAMETERS: ! ! Message_address - Address of the message to put parity on. ! Message_length - Lengtho of the message. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN MAP MESSAGE : REF VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)]; LOCAL POINTER; ! Point into the message IF NOT .DEV_PARITY_FLAG THEN BEGIN POINTER = CH$PTR (.MESSAGE,, CHR_SIZE); INCR I FROM 1 TO .LENGTH DO CH$WCHAR_A (GEN_PARITY (CH$RCHAR (.POINTER)), POINTER); END; END; ! End of DO_PARITY %SBTTL 'Parity routine' GLOBAL ROUTINE GEN_PARITY (CHARACTER) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will add parity to the character that is supplied. ! ! CALLING SEQUENCE: ! ! CHARACTER = GEN_PARITY(CHARACTER) ! ! INPUT PARAMETERS: ! ! CHARACTER - Produce the parity for this character depending on the ! setting of the SET PARITY switch. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL TEMP_CHAR; CASE .PARITY_TYPE FROM PR_MIN TO PR_MAX OF SET [PR_NONE] : RETURN .CHARACTER; [PR_SPACE] : RETURN .CHARACTER AND %O'177'; [PR_MARK] : RETURN .CHARACTER OR %O'200'; [PR_ODD] : TEMP_CHAR = .CHARACTER AND %O'177' OR %O'200'; [PR_EVEN] : TEMP_CHAR = .CHARACTER AND %O'177'; TES; TEMP_CHAR = .TEMP_CHAR XOR (.TEMP_CHAR^-4); TEMP_CHAR = .TEMP_CHAR XOR (.TEMP_CHAR^-2); IF .TEMP_CHAR<0, 2> EQL %B'01' OR .TEMP_CHAR<0, 2> EQL %B'10' THEN RETURN .CHARACTER AND %O'177' OR %O'200' ELSE RETURN .CHARACTER AND %O'177'; END; ! End of GEN_PARITY %SBTTL 'Per transfer -- Initialization' ROUTINE INIT_XFR : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will initialize the various locations that the ! send and receive statistics are kept. ! ! CALLING SEQUENCE: ! ! INIT_XFR(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! ! Determine if we should do 8 bit quoting ! IF .PARITY_TYPE NEQ PR_NONE THEN BEGIN RECV_8QUOTE_CHR = .RCV_8QUOTE_CHR; END ELSE BEGIN RECV_8QUOTE_CHR = %C'Y'; END; NUM_RETRIES = 0; SEND_8QUOTE_CHR = .RECV_8QUOTE_CHR; ! ! Send parameters that may not get set before we need them for the first ! time. ! SEND_PKT_SIZE = ABS (.SND_PKT_SIZE); SEND_NPAD = ABS (.SND_NPAD); SEND_PADCHAR = ABS (.SND_PADCHAR); SEND_TIMEOUT = ABS (.SND_TIMEOUT); SEND_EOL = ABS (.SND_EOL); SEND_QUOTE_CHR = ABS (.SND_QUOTE_CHR); ! ! For initialization messages, we must use single character checksum ! When the send-init/ack sequence has been done, we will switch to the ! desired form ! BLK_CHK_TYPE = CHK_1CHAR; INI_CHK_TYPE = .CHKTYPE; ! Send desired type ! ! Set desired repeat character for use in we are doing send-init ! Will be overwritten by other ends desired character if it sends ! the send-init. ! REPT_CHR = .SET_REPT_CHR; ! ! Assume packet assembly/disassembly uses characters from a file ! GET_CHR_ROUTINE = GET_FILE; ! Initialize the get-a-char routine PUT_CHR_ROUTINE = PUT_FILE; ! And the put-a-char TEXT_HEAD_FLAG = FALSE; ! And assume we will get an File header NO_FILE_NEEDED = FALSE; ! Assume will do file ops INIT_PKT_SENT = FALSE; ! And no server-init sent ! ! Always start with packet number 0 ! MSG_NUMBER = 0; ! Initial message number ! ! Stats information ! SMSG_TOTAL_CHARS = 0; RMSG_TOTAL_CHARS = 0; SMSG_DATA_CHARS = 0; RMSG_DATA_CHARS = 0; SMSG_COUNT = 0; RMSG_COUNT = 0; RMSG_NAKS = 0; SMSG_NAKS = 0; XFR_TIME = SY_TIME (); END; ! End of INIT_XFR %SBTTL 'Statistics -- Finish message transfer' ROUTINE END_STATS : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will end the collection of the statistices. It will ! update the various overall statistic parameters. ! ! CALLING SEQUENCE: ! ! END_STATS (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN SND_COUNT = .SND_COUNT + .SMSG_COUNT; RCV_COUNT = .RCV_COUNT + .RMSG_COUNT; SND_TOTAL_CHARS = .SND_TOTAL_CHARS + .SMSG_TOTAL_CHARS; SND_DATA_CHARS = .SND_DATA_CHARS + .SMSG_DATA_CHARS; RCV_TOTAL_CHARS = .RCV_TOTAL_CHARS + .RMSG_TOTAL_CHARS; RCV_DATA_CHARS = .RCV_DATA_CHARS + .RMSG_DATA_CHARS; SND_NAKS = .SND_NAKS + .SMSG_NAKS; RCV_NAKS = .RCV_NAKS + .RMSG_NAKS; XFR_TIME = SY_TIME () - .XFR_TIME; TOTAL_TIME = .TOTAL_TIME + .XFR_TIME; END; ! End of END_STATS %SBTTL 'Status type out -- STS_OUTPUT' ROUTINE STS_OUTPUT : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will output the current status of a transfer. ! This is used when the user types a ^A during a transfer. ! ! CALLING SEQUENCE: ! ! STS_OUTPUT () ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! Statistics blocks, file names, etc. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TT_CHAR (%C'['); ! Start the message CASE .STATE FROM STATE_MIN TO STATE_MAX OF SET [STATE_ID, STATE_II] : TT_TEXT (UPLIT (%ASCIZ'Idle in server mode')); [STATE_S, STATE_SF] : BEGIN TT_TEXT (UPLIT (%ASCIZ'Initializing for sending file ')); TT_TEXT (FILE_NAME); END; [STATE_SI] : TT_TEXT (UPLIT (%ASCIZ'Initializing for remote command')); [STATE_SG] : TT_TEXT (UPLIT (%ASCIZ'Waiting for response to remote command')); [STATE_SD] : BEGIN TT_NUMBER (.FILE_CHARS); TT_TEXT (UPLIT (%ASCIZ' characters sent for file ')); TT_TEXT (FILE_NAME); END; [STATE_SZ] : BEGIN TT_TEXT (UPLIT (%ASCIZ'At end of file ')); TT_TEXT (FILE_NAME); END; [STATE_SB] : TT_TEXT (UPLIT (%ASCIZ'Finishing transfer session')); [STATE_R] : TT_TEXT (UPLIT (%ASCIZ'Waiting for initialization')); [STATE_RF] : TT_TEXT (UPLIT (%ASCIZ'Waiting for next file or end of session')); [STATE_RD] : BEGIN TT_NUMBER (.FILE_CHARS); TT_TEXT (UPLIT (%ASCIZ' characters received for file ')); TT_TEXT (FILE_NAME); END; [STATE_C] : TT_TEXT (UPLIT (%ASCIZ' Session complete')); [STATE_A] : TT_TEXT (UPLIT (%ASCIZ' Session aborted')); [INRANGE, OUTRANGE] : TT_TEXT (UPLIT (%ASCIZ' Unknown state')); TES; SELECTONE .STATE OF SET [STATE_S, STATE_SF, STATE_SD, STATE_SZ, STATE_SB] : BEGIN IF .RMSG_NAKS GTR 0 THEN BEGIN TT_TEXT (UPLIT (%ASCIZ', ')); TT_NUMBER (.RMSG_NAKS); TT_TEXT (UPLIT (%ASCIZ' NAKs received')); END; END; [STATE_R, STATE_RF, STATE_RD] : BEGIN IF .SMSG_NAKS GTR 0 THEN BEGIN TT_TEXT (UPLIT (%ASCIZ', ')); TT_NUMBER (.SMSG_NAKS); TT_TEXT (UPLIT (%ASCIZ' NAKs sent')); END; END; TES; TT_CHAR (%C']'); ! End the line TT_CRLF (); ! with a CRLF END; ! End of STS_OUTPUT %SBTTL 'TYPE_CHAR - Type out a character' ROUTINE TYPE_CHAR (CHARACTER) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is used as an alternate output routine for BFR_EMPTY. ! It will type the character on the terminal, and always return a ! true status. ! ! CALLING SEQUENCE: ! ! STATUS = TYPE_CHAR (.CHARACTER); ! ! INPUT PARAMETERS: ! ! CHARACTER - The character to type ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TT_CHAR (.CHARACTER); ! Type the character RETURN KER_NORMAL; ! And return OK END; ! End of TYPE_CHAR %SBTTL 'Debugging -- DBG_SEND' ROUTINE DBG_SEND (ADDRESS, LENGTH) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will output the message that is going to be sent ! as part of the debugging information that is turned on in the ! SET DEBUG command. ! ! CALLING SEQUENCE: ! ! DBG_SEND(MSG_ADDRESS, MSG_LENGTH); ! ! INPUT PARAMETERS: ! ! MSG_ADDRESS - Address of the message that is going to be sent ! to the remote KERMIT. The bytes are CHR_SIZE. ! MSG_LENGTH - Length of the message. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN BIND SEND_TEXT = UPLIT (%ASCIZ'Sending...'); IF .DEBUG_FLAG THEN BEGIN LOCAL OLD_RTN; OLD_RTN = TT_SET_OUTPUT (DBG_DUMP); TT_TEXT (SEND_TEXT); DBG_MESSAGE (.ADDRESS, .LENGTH); TT_SET_OUTPUT (.OLD_RTN); END; END; ! End of DBG_SEND %SBTTL 'Debugging -- DBG_RECEIVE' ROUTINE DBG_RECEIVE (ADDRESS) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will output the message that was received from ! the remote KERMIT. This routine is called only if the DEBUG_FLAG ! is true. ! ! CALLING SEQUENCE: ! ! DBG_RECEIVE(MSG_ADDRESS); ! ! INPUT PARAMETERS: ! ! MSG_ADDRESS - Address of the message received by the remote KERMIT. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN BIND RECEIVE_TEXT = UPLIT (%ASCIZ'Received...'); IF .DEBUG_FLAG THEN BEGIN LOCAL OLD_RTN; OLD_RTN = TT_SET_OUTPUT (DBG_DUMP); TT_TEXT (RECEIVE_TEXT); DBG_MESSAGE (.ADDRESS, .REC_LENGTH); TT_SET_OUTPUT (.OLD_RTN); END; END; ! End of DBG_RECEIVE %SBTTL 'Debugging -- DBG_MESSAGE' ROUTINE DBG_MESSAGE (MSG_ADDRESS, MSG_LENGTH) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will display a message that is either being sent ! or received on the user's terminal. ! ! CALLING SEQUENCE: ! ! DBG_MESSAGE(MSG_ADDRESS, MSG_LENGTH); ! ! INPUT PARAMETERS: ! ! MSG_ADDRESS - Address of the message to be output ! MSG_LENGTH - Length of the message to be output. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN MAP MSG_ADDRESS : REF VECTOR [CH$ALLOCATION (MAX_MSG, CHR_SIZE)]; ! Point to the vector LOCAL OLD_RTN, ! Old type out routine CHKSUM, ! Numeric value of block check TEMP_POINTER, ! Temporary character pointer MSG_MSG, ! [108] ! Starting point for data MSG_LEN; ! ! Message type text ! BIND DATA_TEXT = UPLIT (%ASCIZ' (Data)'), ACK_TEXT = UPLIT (%ASCIZ' (ACK)'), NAK_TEXT = UPLIT (%ASCIZ' (NAK)'), SND_INIT_TEXT = UPLIT (%ASCIZ' (Send init)'), BREAK_TEXT = UPLIT (%ASCIZ' (Break)'), TEXT_TEXT = UPLIT (%ASCIZ' (Text header)'), FILE_TEXT = UPLIT (%ASCIZ' (File header)'), EOF_TEXT = UPLIT (%ASCIZ' (EOF)'), ERROR_TEXT = UPLIT (%ASCIZ' (Error)'), RCV_INIT_TEXT = UPLIT (%ASCIZ' (Receive initiate)'), COMMAND_TEXT = UPLIT (%ASCIZ' (Command)'), KERMIT_TEXT = UPLIT (%ASCIZ' (Generic KERMIT command)'); ! ! Header information ! BIND MN_TEXT = UPLIT (%ASCIZ'Message number: '), LENGTH_TEXT = UPLIT (%ASCIZ' Length: '), DEC_TEXT = UPLIT (%ASCIZ' (dec)'), MSG_TYP_TEXT = UPLIT (%ASCIZ'Message type: '), CHKSUM_TEXT = UPLIT (%ASCIZ'Checksum: '), CHKSUM_NUM_TEXT = UPLIT (%ASCIZ' = '), OPT_DATA_TEXT = UPLIT (%ASCIZ'Optional data: '), PRE_CHAR_TEXT = UPLIT (%ASCIZ' "'); ! ! Ensure that the type out will go to the debugging location ! OLD_RTN = TT_SET_OUTPUT (DBG_DUMP); ! ! Preliminary calculations ! MSG_LEN = UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_COUNT, CHR_SIZE))); MSG_MSG = PKT_MSG; ! [108] IF .MSG_LEN EQL 0 ! [108] THEN ! [108] BEGIN ! [108] MSG_LEN = UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_COUNTX1, CHR_SIZE))) * 95 + UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_COUNTX2, CHR_SIZE))) + PKT_HCHECK - 1; ! [108] MSG_MSG = PKT_MSGX; ! [108] END; ! [108] ! ! First output some header information for the packet. ! TT_CRLF (); TT_TEXT (MN_TEXT); TT_NUMBER (UNCHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_SEQ, CHR_SIZE)))); TT_TEXT (DEC_TEXT); TT_TEXT (LENGTH_TEXT); TT_NUMBER (.MSG_LEN); TT_TEXT (DEC_TEXT); TT_CRLF (); ! ! Now output the message type and dependent information ! TT_TEXT (MSG_TYP_TEXT); TT_CHAR (CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_TYPE, CHR_SIZE))); SELECTONE CH$RCHAR (CH$PTR (.MSG_ADDRESS, PKT_TYPE, CHR_SIZE)) OF SET [MSG_DATA] : TT_TEXT (DATA_TEXT); [MSG_ACK] : TT_TEXT (ACK_TEXT); [MSG_NAK] : TT_TEXT (NAK_TEXT); [MSG_SND_INIT] : TT_TEXT (SND_INIT_TEXT); [MSG_BREAK] : TT_TEXT (BREAK_TEXT); [MSG_FILE] : TT_TEXT (FILE_TEXT); [MSG_TEXT] : TT_TEXT (TEXT_TEXT); [MSG_EOF] : TT_TEXT (EOF_TEXT); [MSG_ERROR] : TT_TEXT (ERROR_TEXT); [MSG_GENERIC] : TT_TEXT (KERMIT_TEXT); [MSG_COMMAND] : TT_TEXT (COMMAND_TEXT); TES; TT_CRLF (); ! ! Now output any of the optional data. ! IF .MSG_LEN - .MSG_MSG + 1 - (.BLK_CHK_TYPE - CHK_1CHAR) NEQ 0 ! [108] THEN BEGIN TT_TEXT (OPT_DATA_TEXT); TT_CRLF (); TEMP_POINTER = CH$PTR (.MSG_ADDRESS, .MSG_MSG, CHR_SIZE); ! [108] INCR I FROM 1 TO .MSG_LEN - .MSG_MSG + 1 - (.BLK_CHK_TYPE - CHK_1CHAR) DO ! [108] BEGIN IF (.I MOD 10) EQL 1 THEN BEGIN TT_CRLF (); TT_CHAR (CHR_TAB); END; TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR_A (TEMP_POINTER)); TT_CHAR (%C'"'); END; IF ((.MSG_LEN - .MSG_MSG + 1 - (.BLK_CHK_TYPE - CHK_1CHAR)) MOD 10) EQL 1 THEN TT_CRLF (); ! [108] TT_CRLF (); END; ! ! Now output the checksum for the message that we received ! ! This could be either 1 two or three characters. TT_TEXT (CHKSUM_TEXT); TEMP_POINTER = CH$PTR (.MSG_ADDRESS, .MSG_LEN + PKT_CHKSUM + 1 - (.BLK_CHK_TYPE - CHK_1CHAR), CHR_SIZE); ! [108] CASE .BLK_CHK_TYPE FROM CHK_1CHAR TO CHK_CRC OF SET [CHK_1CHAR] : BEGIN TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM = UNCHAR (CH$RCHAR (.TEMP_POINTER)); END; [CHK_2CHAR] : BEGIN CHKSUM = 0; TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<6, 6> = UNCHAR (CH$RCHAR_A (TEMP_POINTER)); TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<0, 6> = UNCHAR (CH$RCHAR (.TEMP_POINTER)); END; [CHK_CRC] : BEGIN CHKSUM = 0; TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<12, 4> = UNCHAR (CH$RCHAR_A (TEMP_POINTER)); TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<6, 6> = UNCHAR (CH$RCHAR_A (TEMP_POINTER)); TT_TEXT (PRE_CHAR_TEXT); TT_CHAR (CH$RCHAR (.TEMP_POINTER)); TT_CHAR (%C'"'); CHKSUM<0, 6> = UNCHAR (CH$RCHAR (.TEMP_POINTER)); END; TES; TT_TEXT (CHKSUM_NUM_TEXT); TT_NUMBER (.CHKSUM); TT_TEXT (DEC_TEXT); TT_CRLF (); TT_SET_OUTPUT (.OLD_RTN); ! Reset output destination END; ! End of DBG_MESSAGE %SBTTL 'End of KERMSG' END ELUDOM